Function GetSciezka() As String
With Application.FileDialog(msoFileDialogFilePicker)
'tytul okienka dialogowego
.Title = "Wybierz folder z plikami do importu"
'mozna wybrac tylko jeden katalog
.AllowMultiSelect = False
If .Show = -1 Then
GetSciezka = .SelectedItems(1)
Else
'Show zwraca -1 dla wybierz oraz 0 w pozostałych przypadkach
GetSciezka = 0
End If
End With
End Function


Sub zapisDanych(wBook As Workbook, tenBook As Workbook)
Dim tenSheet As Worksheet
Set tenSheet = tenBook.Sheets("Arkusz1")
tenSheet.Cells.Clear
Dim wSheet As Worksheet
Set wSheet = wBook.Sheets("Arkusz1")
wSheet.Cells.Copy tenBook.Sheets("Arkusz1").Range("a1")
End Sub

Sub GlownyProgram()
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim sWybranyKatalog As String
sWybranyKatalog = GetSciezka()
If sWybranyKatalog = "0" Then
MsgBox "Nie Wybrales Sciezki do importu"
Else
'obiekt folder zapewnia dostęp do właściwości folderu
Dim Katalog As File
Set Katalog = fso.GetFile(sWybranyKatalog)
'obiekt plik obsługuje zawartość pliku
Dim ten_plik As Workbook: Set ten_plik = ActiveWorkbook
Dim myBook As Workbook
Set myBook = Workbooks.Open(sWybranyKatalog)
Call zapisDanych(myBook, ten_plik)
myBook.Close False
End If
End Sub

Ten kod dziala jak chce , tylko jeszcze jedna prosba jak przerobic program zeby kopiowal arkusza o takiej samej nazwie jak wybrany plik do arkusza 1 pliku macierzystego?

tak

nie

może

ja nie rozumieć Twoja niejasne sformułowanie w ostatnie 3 zdania Twoja wypowiedź.

Kopiowanie arkusza można nawet rejestratorem makr zarejestrować - co za problem później dopisać nazwy plików?

Co do kodu - straszy bałagan. Weź chociaż setnij zmienne obiektowe na nothing po zakończeniu tego bajzlu, porób jakieś wolne linie (to nic nie kosztuje) - jak widzę taki kod jak wkleiłeś to...... :)

W ogóle masz o tym jakieś pojęcie? Bo na moje to wygląda tak, że wkleiłeś czyjś kawałek kodu (do tego niedbale napisany) i chcesz żeby Ci teraz poprawić.

Nie znam się na VBA przerobilem podobny kod


Program dziala tak ze po uruchomieniu w pliku macierzystym wybieram plik a on kopiuje mi zawartosc Arkusza 1 do Arkusza 1 pliku macierzystego.

Teraz muszę go przerobić żeby kopiowal do Arkusza 1 arkusz o nazwie takiej samej jak wybrany plik

no to dam Ci wędkę:

całe kopiowanie masz w tym kawałku:
Sub zapisDanych(wBook As Workbook, tenBook As Workbook)
Dim tenSheet As Worksheet
Set tenSheet = tenBook.Sheets("Arkusz1")
tenSheet.Cells.Clear
Dim wSheet As Worksheet
Set wSheet = wBook.Sheets("Arkusz1")
wSheet.Cells.Copy tenBook.Sheets("Arkusz1").Range("a1")
End Sub



'tutaj masz gdzie kopiujemy:
Set tenSheet = tenBook.Sheets("Arkusz1") 'do którego arkusza
tenSheet.Cells.Clear ' najpierw czyścuimy arkusz

'tutaj masz CO kopiujemy:
Dim wSheet As Worksheet
Set wSheet = wBook.Sheets("Arkusz1") 'czyli z wybranego pliku arkusz "Arkusz1" jeśli chcesz inny arkusz, to tutaj wstawiasz nazwę innego arkusz

'A tutaj linijka kopiowania' logika: co kupiujemy COPY gdzie kopiujemy
wSheet.Cells.Copy tenBook.Sheets("Arkusz1").Range("a1")

Jeśli chcesz wyciągnąć nazwę arkusza/pliku, to każdy z tych obiektów ma właściwość Name. Możesz ją wyciągnąć, np

dim temp as string 'deklaracja zmiennej tekstowej
temp = activesheet.name 'przypisuje pod zmienną temp nazwę aktywnego arkusza



Prościej się nie da - musiałbym to za Ciebie zrobić, a tego robić nie mam zamiaru :)

Function GetSciezka() As String
With Application.FileDialog(msoFileDialogFilePicker)
'tytul okienka dialogowego
.Title = "Wybierz folder z plikami do importu"
'mozna wybrac tylko jeden katalog
.AllowMultiSelect = False
If .Show = -1 Then
GetSciezka = .SelectedItems(1)
Dim temp As String 'deklaracja zmiennej tekstowej
temp = ActiveFile.Name 'przypisuje pod zmienną temp nazwę aktywnego arkusza
'obiekt plik obsługuje zawartość pliku
Else
'Show zwraca -1 dla wybierz oraz 0 w pozostałych przypadkach
GetSciezka = 0
End If
End With
End Function


Sub zapisDanych(wBook As Workbook, tenBook As Workbook, temp2 As String)
Dim tenSheet As Worksheet
Set tenSheet = tenBook.Sheets("Arkusz1")
tenSheet.Cells.Clear
Dim wSheet As Worksheet
Set wSheet = wBook.Sheets(temp2)
wSheet.Cells.Copy tenBook.Sheets(temp2).Range("a1")
End Sub

Sub GlownyProgram()
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim sWybranyKatalog As String
sWybranyKatalog = GetSciezka()
If sWybranyKatalog = "0" Then
MsgBox "Nie Wybrales Sciezki do importu"
Else
'obiekt folder zapewnia dostęp do właściwości folderu
Dim Katalog As File
Set Katalog = fso.GetFile(sWybranyKatalog)
Dim ten_plik As Workbook: Set ten_plik = ActiveWorkbook
Dim myBook As Workbook
Set myBook = Workbooks.Open(sWybranyKatalog)
Call zapisDanych(myBook, ten_plik, temp)
myBook.Close False
End If
End Sub


Nie wiem jak podebrac nazwe tego pliku i w ktorym miejscu ;/

ten kod powinien być ok (pisane na szybko tutaj):

Dim temp2 As String 'deklaracja
temp2 = wbook.Name 'pobranie pelnej nazwy (z rozszerzeniem)
temp2 = Left(temp2, Len(temp2) - 5) ' odcięcie rozszerzenia. Jeśli ".xlsx" to ma być cyfra 5, jeśli ".xls" to 4

gdzie wkleić? Przed Set wSheet = w.Book.Sheets(temp2)