[Excel] Odczyt danych z plików, odczyt wartości z nazwy plik

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  If SaveAsUI = False Then Cancel = True
End Sub

ActiveWorkbook.SaveAs

Sub makro()
  Nr = 1
  nazwa = "plik" & Nr & ".xls"
  Application.Dialogs(xlDialogSaveAs).Show ("c:\" & nazwa)
End Sub

Sub Przycisk28_Kliknięcie()

sciezka = Application.DefaultFilePath & "\"
'sciezka = "C:\agata\"
nazwa = Range("D4").Value
ZapiszJako = Application.GetSaveAsFilename(InitialFileName:=sciezka & nazwa, fileFilter:="Skoroszyt Excel (*.xls), *.xls")

ActiveSheet.PrintOut Copies:=2

End Sub

ActiveSheet.PrintOut Copies:=2 

ThisWorkbook.SaveAs ZapiszJako

Dim MyNumber
wiersz = 4

Open "C:\agata\test.txt" For Input As #1
Do While Not EOF(1)
    Input #1, MyNumber
    Cells(4, wiersz).Value = MyNumber
    wiersz = wiersz + 1
    
Loop
Close #1

Sub OperacjeHurtowe()
Dim wbkSkoroszyt As Workbook
Dim i As Long, szukWiersz As Long, wiersz As Long
Dim sciezka As String
' okreslam sciezke szukania jako podkatalg Dane katalogu gdzie znajduje sie skoroszyt Zbiorczy
sciezka = ThisWorkbook.Path & "\Dane"
wiersz = 1 ' zmienna okreslajaca biezacy wiersz w arkuszu gdzie zbieram dane

  With Application.FileSearch   ' zaczynam prace z obiektem FileSearch
    .NewSearch                  ' nowe szukanie
    .LookIn = sciezka           ' sciezka poszukiwan
    .SearchSubFolders = False   ' szukanie w podfolderach - nie
    .Filename = "*.xls"         ' nazwa plików
    .FileType = msoFileTypeExcelWorkbooks ' typ pliku - Excel
   
    ' jezeli liczba znalezionych (i posortowanych przy okazji) jest wieksza od zero
    If .Execute(msoSortByFileName) > 0 Then
        ' robie petle od 1 do liczby znalezionych plików
        For i = 1 To .FoundFiles.Count
            ' otwieram 1 odnaleziony skoroszyt (a w nastepnych obiegach petli  2,3 az do ilosci znalezionych)
            Set wbkSkoroszyt = Workbooks.Open(.FoundFiles(i))
            'aktywuje ten skoroszyt
            wbkSkoroszyt.Activate
            With wbkSkoroszyt.Worksheets(2) ' w pierwszym arkuszu tego skoroszytu
            'szukam ostatniego niepustego wiersza w kolumnach A:G (do poprawienia wedlug potrzeb)
            'mozna tez zamiast Range("E18:AD18") wpisac Cells wtedy bedzie szukal ostatniej niepustej we wszystkich kolumnach
            szukWiersz = .Range("E18:AD113").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            'kopiuje zakres od drugiego wiersza do ostatniego zapisanego do kolumny G (do poprawienia wedlug potrzeb)
            .Range("E18:AD" & szukWiersz).Copy Destination:=Workbooks("Zbiorczy.xls").Worksheets(1).Range("A" & wiersz)
            'zwiekszam wiersz o ilosc wkopiowanych wierszy - 1 naglówek
            wiersz = wiersz + szukWiersz - 17
            End With ' tyle operacji na tym arkuszu
            wbkSkoroszyt.Close False 'zamykam odnaleziony skoroszyt bez zapisywania zmian
        Next i ' idz do nastepnego skoroszytu
    Else ' jezeli nie znalazlem plików w podanej lokalizacji
        MsgBox "Nie znaleziono zadnych plików" ' daje komunikat
    End If ' koniec mozliwosci odnoscie znajdowania
  End With 'koncze prace w obiektem FileSearch

End Sub