MS Excel - automatyczne kopiowanie danych z plików o tej samej strukturze danych ale o innej nazwie

Excel 2010 - makro nie działa @ **bag** | **30.04.2014**

2
4
1.5K

Jak powinien wyglądać prosty, ale i wydajny kod VBA, który do pliku głównego (*.xlsm) będzie kopiować ten sam zakres danych (liczby) z różnych plików o tej samej strukturze danych ale, różnej nazwie. Nazwy plików (bez rozszerzeń) byłyby pobierane z wybranej kolumny pliku głównego (od A3:A50) - następnie 13 liczb pobieranych z każdego docelowego pliku miałoby być skopiowane do zakresu B3:N3).

Próbowałem to robić otwierając każdy plik, zaznaczając zakres i kopiując do pliku głównego. Niestety, nie było to doskonale i po otwarciu kilku plików pojawiały się błędy. Nie wklejam kodu, bo jego analiza mogłaby być dłuższa niż propozycja. :)

Dodatkowe parametry:

Pliki są w tym samym katalogu.
W plikach nie ma zmian, mogą być tylko do odczytu.
Każdy plik to XYZ.xlsm - gdzie XYZ to kolejna nazwa wybierana przez kod.
Każda z 13 liczb musi być sprawdzona, czy jest liczbą. Jeśli nie jest - wstawiany jest opis N/A do komórki docelowej w pliku głównym.
Lista nazw plików (w rzeczywistości kod produktu - o stałej długości znaków), może być w zakresie A3:A50, jak również może się powiększać. Kod powinien uwzględniać ostatni zapisany rekord w tej kolumnie.
Na końcu kodu - plik główny powinien być zapisany.

Dziękuję za wszelkie sugestie.
Pozdrawiam Tomek.

Zapytał
@ Tomasz_Siepielski | 08.07.2015
- 1
- 0
- 1

Komentarze (1)

Witam,

Poprosiłbym o jakiś przykładowe pliki źródłowe i jak to powinno wyglądać po konsolidacji. Dane oczywiście mogą być nie prawdziwe.
Pozdrawiam
Paweł Niemyt

Skomentował : @ pawel_niemyt ,14.07.2015

10

Witam serdecznie.

Z informacji, które posiadam z opisu, proponuję taki kod:

Sub Konsolidacja1()

Dim nazwa_pliku As String
Dim docelowy As Workbook
Dim odczytany As Workbook
Dim komorka As Range
Dim sciezka As String
Dim wiersz As Long

Application.ScreenUpdating = False

sciezka = "C:\Users\kowalski\"

Set docelowy = ThisWorkbook

For Each komorka In docelowy.Worksheets("Lista plikow").Range("a3").CurrentRegion

    Debug.Print komorka.Value
    
    Set odczytany = Workbooks.Open(sciezka & komorka.Value & ".xlsx")
    odczytany.Worksheets(1).Range("b3:n3").Copy
    wiersz = 2
    Do While docelowy.Worksheets(1).Cells(wiersz, 2) <> ""
    
        wiersz = wiersz + 1
    
    Loop

    docelowy.Worksheets(1).Cells(wiersz, 2).PasteSpecial
    docelowy.Worksheets(1).Cells(wiersz, 1) = komorka.Value
    odczytany.Save
    odczytany.Close

Next

Set komorka = Nothing

For Each komorka In docelowy.Worksheets(1).Range(Cells(3, 2), Cells(3, 2).End(xlToRight).End(xlDown))

    If Not IsNumeric(komorka.Value) Then komorka.Value = ""

Next
docelowy.Save

End Sub

Procedura otwiera każdy plik z listy, wrzuca do pliku docelowego i następnie sprawdza, czy wszystkie dane są liczbami.

W załączeniu pliki.

Pozdrawiam.
Paweł Niemyt.

Załączniki

rar
konsolidacja.rar ( 33K )

Komentarze (1)

Odpowiedział
@ pawel_niemyt | 22.07.2015

Komentarze

Dziękuje bardzo, chętnie sprawdzę. Na plikach z załącznika działa świetnie.

W załączeniu moje przykładowe pliki (zostawiłem struktura, reszta poufna ;) )
pozdrawiam
Tomek Siepielski

Skomentował : @ Tomasz_Siepielski ,22.07.2015

1
0
1

3

Przykładowe pliki.

Załączniki

zip
PLIKIVBA.zip ( 46K )

Skomentuj

Odpowiedział
@ Tomasz_Siepielski | 22.07.2015
- 1
- 0
- 1

Pytanie