Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek dla www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

VBA Excel makro kopiujace dane z wielu plikow do jednego arkusza

06 Gru 2013 12:16 3618 4
  • Poziom 2  
    Witam,

    Potrzebna mi pomoc w napisaniu makra w Excelu. Chciałbym wczytać dane z wielu plików .xlsx i wpisać je do jednego.
    Dla uproszczenia powiedzmy że pliki źródłowe to tabelki 4x4 pola. Chciałbym żeby makro otwierało po kolei każdy plik i wrzucało wszystkie dane z niego w jeden wiersz, w 16 kolejnych pól. Potem drugi plik to drugi wiersz itd.

    Jestem zielony w makrach i czytając tutoriale i kilka tematów na tym forum wymęczyłem coś takiego.

    ChDir "D:\wodociagi\dane z ankiet\zbiorcze"
    Workbooks.Open Filename:="D:\wodociagi\dane z ankiet\zbiorcze\za15.xlsx.xlsx"
    ChDir "D:\wodociagi\dane z ankiet\a\15 - Kopia"
    Dim i As Integer
    For i = 1 To 10
    Cells(1, i) = i
    Workbooks.Open Filename:=" D:\wodociagi\dane z ankiet\a\15 - kopia\1.xlsx"
    Workbooks.Open Filename:=" D:\wodociagi\dane z ankiet\a\15 - kopia\" & i & ".xlsx"
    Range("b2").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(3, i + 9).Select
    ActiveSheet.Paste
    Range("a15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(4, i + 9).Select
    ActiveSheet.Paste
    Range("b15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(5, i + 9).Select
    ActiveSheet.Paste
    Next i
    End Sub

    Pliki źródłowe nazywają się 1.xlsx, 2.xlsx itd.,
    polecenie:

    Workbooks.Open Filename:=" D:\wodociagi\dane z ankiet\a\15 - kopia\1.xlsx"

    otwiera plik 1.xlsx, natomiast polecenie:

    Workbooks.Open Filename:=" D:\wodociagi\dane z ankiet\a\15 - kopia\" & i &

    wyświetla komunikat, że nie można znaleźć pliku i podaje prawidłową nazwę i lokalizację ( D:\wodociagi\dane z ankiet\a\15 - kopia\1.xlsx).
    Dlaczego tak się dzieje?
  • Poziom 22  
    Może pliki nazywają się inaczej lub pełna ścieżka jest jednak inna?
    Zwróć proszę uwagę na spacje i rozszerzenia - wkleiłeś m.in. coś takiego:
    Code:

    "D:\wodociagi\dane z ankiet\zbiorcze"
    " D:\wodociagi\dane z ankiet\a\15 - kopia\1.xlsx"

    "\za15.xlsx.xlsx"

    Obecność pliku w podanej lokalizacji można sprawdzić:
    If Dir(pełna_ścieżka_do_pliku)<>"" Then msgbox "plik jest"

    Zakładam, że pliki nie mają zmienionych atrybutów...
  • Poziom 2  
    Winna była spacja. Dzięki. Skupiałem się na sprawdzaniu nazwy pliku, sciezki a spacja mi się nie rzucała w oczy. Masakra ...

    Teraz mam coś takiego :

    Sub Makro3()
    '
    ' Makro3 Makro
    '

    '
    Dim i As Integer
    For i = 1 To 10
    ChDir "D:\wodociagi\dane z ankiet\zbiorcze"
    Workbooks.Open Filename:="D:\wodociagi\dane z ankiet\zbiorcze\za15.xlsx.xlsx"
    Dim zbiorcze As Workbook
    Set zbiorcze = ThisWorkbook
    ChDir "D:\wodociagi\dane z ankiet\a\15 - Kopia"
    Workbooks.Open Filename:="D:\wodociagi\dane z ankiet\a\15 - kopia\" & i & ".xlsx"
    Dim wpisywane As Workbook
    Set wpisywane = ThisWorkbook
    wpisywane.Activate
    Range("b2").Select
    Selection.Copy
    zbiorcze.Activate
    Cells(i + 2, 10).Select
    ActiveSheet.Paste
    Range("a15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(i + 2, 11).Select
    ActiveSheet.Paste
    Range("b15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(i + 2, i + 12).Select
    ActiveSheet.Paste
    Range("c15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(i + 2, 13).Select
    ActiveSheet.Paste
    Range("d15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(i + 2, 14).Select
    ActiveSheet.Paste
    Range("e15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(i + 2, 15).Select
    ActiveSheet.Paste
    Range("f15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(i + 2, 16).Select
    ActiveSheet.Paste
    Range("g15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(i + 2, 17).Select
    ActiveSheet.Paste
    Range("h15").Select
    Selection.Copy
    Windows("za15.xlsx.xlsx").Activate
    Cells(i + 2, 18).Select
    ActiveSheet.Paste
    wpisywane.Activate
    Range("i15").Select
    Selection.Copy
    zbiorcze.Activate
    Cells(i + 2, 19).Select
    ActiveSheet.Paste
    wpisywane.Activate
    Range("j15").Select
    Selection.Copy
    zbiorcze.Activate
    Cells(i + 2, 20).Select
    ActiveSheet.Paste
    Next i
    End Sub

    Odpala już pliki prawidłowo, ale problem jest z uaktywnianiem arkuszy podczas kopiowania/wklejania. Nie wiem jak aktywowac arkusz który nie jest wpisany "z palaca" tylko kolejnym z otwartym przez skrypt
  • Specjalista - VBA, Excel
    ThisWorkbook - Jest to plik, w którym makro, jest zawsze jeden i ten sam

    Dim zbiorcze As Workbook
    Dim wpisywane As Workbook

    Set zbiorcze = Workbooks.Open("D:\wodociagi\dane z ankiet\zbiorcze\za15.xlsx.xlsx")
    Set wpisywane = Workbooks.Open("D:\wodociagi\dane z ankiet\a\15 - kopia\" & i & ".xlsx")

    Set zbiorcze = Workbooks.Open("D:\wodociagi\dane z ankiet\zbiorcze\za15.xlsx.xlsx") musi być przed petli "For i=1 to 10"
  • Poziom 2  
    Bardzo dziękuję za pomoc. Po wcieleniu podpowiedzi w życie, makro dizała jak trzeba. Jeszcze raz dziękuję :)