Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - z kilku plików do jednego - każdy plik jako następny arkusz

Aisza · forumowicz Posty: 15

Witam serdecznie
zwracam się do wszystkich, którzy mogliby pomóc mi w następującej sprawie:

- we folderze mam kilka skoroszytów excel - o różnej nazwie,
- w każdym z nich jest arkusz z nazwą "sprawozdanie", a w nim tabela w takim samym układzie,

i teraz pytanie: jakie makro pozwoli przenieść arkusz z nazwą "sprawozdanie" ze wszystkich skoroszytów w danym folderze, do jednego skoroszytu (np. zbiorówka)... z tym że każdy kopiowany arkusz będzie następnym arkuszem w tej "zbiorówce", a arkusze będą miały nazwy z kolejno pobieranych skoroszytów.

Nie ukrywam, że liczę na Waszą pomoc gdyż kopiowanie na piechotę, nadawanie nazw...powoli mnie wykańcza :)
Z góry dziękuję

negatyv · Wysłany: 2012-02-09, 08:56

Trochę to napisane na kolanie, ale może Ci pomoże. Osobiście wolę wskazywać pliki, niż po prostu ładować wszystkie z katalogu.

Kod:

Option Explicit

Sub Zestawieniedanych()

Dim FileList, MyFile
Dim InputFile As Workbook
Dim MySheet As Worksheet
Dim MyWorkbook As Workbook

Set MyWorkbook = ActiveWorkbook
FileList = Application.GetOpenFilename("Excel (*.xls),*.xls", , "wybierz dane", , True)

For Each MyFile In FileList
Set InputFile = Workbooks.Open(MyFile, 0, True)
For Each MySheet In InputFile.Worksheets
If MySheet.Name = "sprawozdanie" Then
MyWorkbook.Sheets.Add after:=MyWorkbook.Sheets(MyWorkbook.Sheets.Count)
MyWorkbook.Sheets(MyWorkbook.Sheets.Count).Name = InputFile.Name
MySheet.Range("A1:E10").Copy MyWorkbook.Sheets(MyWorkbook.Sheets.Count).Range("A1")
End If
Next
Application.DisplayAlerts = False
InputFile.Close False
Set InputFile = Nothing
Application.DisplayAlerts = True
Next

End Sub

Aisza · forumowicz Posty: 15

ogromne dzięki....działa superowo.. też chciałabym tak napisać szybko "na kolanie" jak kolega...:):):) i racja możliwość wyboru plików z folderu też ma pewne zalety.
A czy można tak przerobić makro żeby zawsze pobierało pierwszy arkusz z każdego skoroszytu - niezależnie od jego nazwy?

jeszcze raz baaardzo dziękuję... moja skóra uratowana :clap

negatyv · Wysłany: 2012-02-09, 22:00

To fajnie, szkoda by było twojej skóry :)

Poszukaj jak działa pętla for each i zastanów się nad tą pętlą:

Kod:

For Each MySheet In InputFile.Worksheets

Aisza · forumowicz Posty: 15

no właśnie szukam ale widać nie skutecznie...
nie mogę znaleźć jak powinien wyglądać zapis makra gdy dane maja być pobierane z pierwszego arkusza niezależnie od jego nazwy If MySheet.Name = "sprawozdanie" Then
nie dźwignę:(

bardzo proszę o pomoc

negatyv · Wysłany: 2012-02-12, 17:17

Do arkuszy możesz się odwoływać przez nazwę:

Kod:

InputFile.Worksheets("sprawozdanie")

lub po prostu przez jego kolejność w pliku:

Kod:

InputFile.Worksheets(1)

Więc to:

Kod:

For Each MySheet In InputFile.Worksheets
If MySheet.Name = "sprawozdanie" Then
MyWorkbook.Sheets.Add after:=MyWorkbook.Sheets(MyWorkbook.Sheets.Count)
MyWorkbook.Sheets(MyWorkbook.Sheets.Count).Name = InputFile.Name
MySheet.Range("A1:E10").Copy MyWorkbook.Sheets(MyWorkbook.Sheets.Count).Range("A1")
End If
Next

zamień na:

Kod:

MyWorkbook.Sheets.Add after:=MyWorkbook.Sheets(MyWorkbook.Sheets.Count)
MyWorkbook.Sheets(MyWorkbook.Sheets.Count).Name = InputFile.Name
InputFile.Worksheets(1).Range("A1:E10")).Copy MyWorkbook.Sheets(MyWorkbook.Sheets.Count).Range("A1")

Aisza · forumowicz Posty: 15

bardzo Ci serdecznie dziękuję!!!
za cierpliwość i wyjaśnienie .....:)
pozdrówka

Majster86 · słuchacz Posty: 14

Witam, Aisza działa Ci to makro? Próbowałem to zrobić, skopiowałem cały kod do edytora VBA i niby działa jednak nie do końca tak jak jest to napisane, jeżeli w plikach mam wszystkie arkusze o tej samej nazwie to bardzo ładnie je kopiuje ale jeżeli arkusze mają już inne nazwy to makro nie działa. Jako że chcę się nauczyć VBA to kombinowałem jak to zrobić żeby działało ale nic z tego :( czy może mi ktoś pomóc jak zrobić żeby kopiował arkusze z różnymi nazwami z rożnych plików do jednego ?

negatyv · Wysłany: 2012-02-17, 19:07

Reklamy w stopce są niezgodne z regulaminem, usuń to zanim dostaniesz ostrzeżenie.
Algorytm kopiuje z pierwszego arkusza:

Kod:

InputFile.Worksheets(1).Range("A1:E10")).Copy

Nie ma prawa działać inaczej, musiałeś coś źle przepisać. Najlepiej podaj swój cały kod w nowym poście i napisz jak według Ciebie powinien działać i jak działa.

Majster86 · słuchacz Posty: 14

Ok usunięte :)

właśnie skopiowałem dokładnie cały kod z tego przykładu najpierw z 1 części i później tej poprawionej która miała kopiować pierwszy arkusz z wybranych skoroszytów i jak maja swoje różne nazwy to nie kopiuje ich. Wiem że ta linia odpowiada za kopiowanie arkusza pierwszego ale jednak coś mi nie śmiga :(