W takim razie, jak zrobić to w miarę automatycznie i powtarzalnie?

Otwierać i zamykać każdy Skoroszyt (plik), to trochę kiepsko przy 600. i co miesiąc dochodzi jakieś 200-300.

Poszukuję jakiegoś automatu, który pobierze nazwę pliku, potem określone dane i wklei w wiersz za wierszem, czyli musi zrobić jeszcze transpozycję danych. Jeśli to wykona konsolidacja, to może jakaś wskazówka. Przesyłam 2 pliki - dane, które chcę skopiować znajdują się w B25:J39. Chcę wykonać takie zestawienie, żeby później raz obrobione pliki podstawić (skopiować) do głównego pliku Szablonu.

W takim razie spróbuj może skorzystać z rozwiązania w VBA, które zamieszczam w dołączonym pliku.

Wypakuj pliki do wspólnego folderu. Demon szybkości to nie jest, ale zawsze coś.

Korzystając z funkcji DIR kolejno pobieram nazwy plików w folderze, a następni wykorzystując ExecuteExcel4Macro pobieram dane z arkuszy Excela. Dla większej przejrzystości rozbiłem na dwie procedury. Kod wygląda następująco.

Sub KonsolidujDane()

    Dim MojPlik As String
    Dim Sciezka As String
    Dim wk As Excel.Workbook
    Dim Arkusz As String
    Dim komorka As String
    Dim wiersz As Long
    Dim kolumna As Long
'    Dim Adres As String
    On Error GoTo Blad
    Application.Calculation = xlCalculationManual

    
    Sciezka = ThisWorkbook.path & "\"
    Arkusz = "Podsumowanie"
    MojPlik = Dir(Sciezka & "\*.xlsx")
    
    Do While MojPlik <> ""
        
        Debug.Print MojPlik
            For wiersz = 1 To 3
                 For kolumna = 1 To 4
                 komorka = Cells(1, kolumna).Address
                 'Ponieważ dokonuję transpozycji zamieniam wierszę z kolumnami
                 ThisWorkbook.Worksheets("Arkusz1").Cells(kolumna, wiersz) = GetValue(Sciezka, MojPlik, Arkusz, komorka)
                 Next kolumna
                MojPlik = Dir
             Next wiersz
       
    Loop
Czyszczenie:
On Error Resume Next
Application.Calculation = xlCalculationAutomatic
Set wk = Nothing
Exit Sub
Blad:
MsgBox Err.Number & ". " & Err.Description
Resume Czyszczenie
    
End Sub

Funkcja GetValue pobiera dane z zamkniętego skoroszytu.

Private Function GetValue(Sciezka, MojPlik, Arkusz, komorka)
'   Pobiera dane z zamkniętego skoroszytu
    Dim arg As String

'   utwórz argument
    arg = "'" & Sciezka & "[" & MojPlik & "]" & Arkusz & "'!" & _
      Range(komorka).Range("A1").Address(, , xlR1C1)
'   Wykonaj makro XLM
    GetValue = ExecuteExcel4Macro(arg)
End Function

Pozdrawiam.
Darek.

Witam serdecznie.

Stawiam dopiero swoje pierwsze kroki w VBA i mam ogromną prośbę, ponieważ nie jestem w stanie zmodyfikować Pańskiego kodu tak, aby nie dokonywał transpozycji oraz konsolidował dane tylko z czwartego wiersza, gdyż we wcześniejszych wierszach zawsze będę miał opisy kolumn. Chodzi mi o taką funkcjonalność, która będzie kopiowała z arkuszy o nazwie dane, we wszystkich skoroszytach w danym folderze, zawartość komórek z zakresu F4:AS4 oraz wstawiała je do kolejnych wierszy w zbiorczym skoroszycie.

Jeszcze jedno, arkusze źródłowe są arkuszami z obsługą makr, nie wiem czy ma to jakiś wpływ na kod.