MICROSOFT EXCEL 2007- Kako kopirati više Sheets iz više datoteka iz foldera u novu radnu knjigu,
Copy specific Sheets from all files in foldewr to new workbook

Kako kopirati više radnih listova iz više datoteka u nekom direktoriju ili mapi
(Copy same multiple Sheets from all files in folder to new Workbook)

Uzmimo situaciju da imate više desetaka datoteka koje sadrže identične nazive radnih listova (Sheets). Vi želite iz svake datoteke kopirati identične radne listove u novu radnu knjigu (Workbook) tako da npr: radna knjiga sadrži sve radne listove pod nazivom Sheet1 u svim datotekama iz foldera. Uz to želite da se svaki radni list (Sheet1) preimenuje nazivom same datoteke. Primjer ću pokazati na ove tri datoteke u C:\Temp folderu (mapi)

Kopirajte sve vaše izvorne datoteke u folder C:\Temp iz kojih je potrebno kopirati određene Sheets

Dakle imamo u jednom folderu više desetaka datoteka a iz njih trebamo u novu Workbook kopirati sve radne listove istog naziva. Tada će nam jedna workbook sadržavati podatke iz svih datoteka sa istih naziva radnih listova.
Ovu radnju odraditi ćemo pomoću VBA makronaredbe.

Otvorite potpuno novu Workbook i preimenujte Sheet1 u neko ime npr: Summary
Obrišite višak radnih listova a to su (Sheet2 i Sheet3). Ovu Workbook možete snimiti u My Document pod nekim nazivom
npr: SUM-Sheet1.xls ako se radi o kopiranju Sheet1
ili SUM-Sheet2.xls ako se radi o kopiranju Sheet2

Ovaj VBA macro kopirajte u Module u VBE vašeg Excela.

Sub KopirajSheetsIzDatoteka()
' kopiranje odredjenih Sheets iz svih Workbook koje se nalaze u folderu
' Workbook nisu zasticene passwordom

Dim myDir As String, fn As String
myDir = "C:\Temp" 'path staza do foldera u kojem se nalaze datoteke
fn = Dir(myDir & "\*.xls") 'extenzija za datoteke iz kojih se kopiraju Sheets
Do While fn <> ""
With Workbooks.Open(myDir & "\" & fn)
With .Sheets("Sheet1") 'Sheet koji se zeli kopirati iz datoteka
.Name = "" & fn & "" 'ako zelite naziv kopiranog sheeta je tipa ime.xls
'.Name = "(" & fn & ")" 'ako zelite naziv kopiranog sheeta je tipa (name.xls)
'.Name = .Name & "(" & fn & ")" 'ako zelite naziv sheeta je tipa Sheet1(name.xls)
.Copy After:=ThisWorkbook.Sheets(1)
End With
.Close False
End With
fn = Dir
Loop
End Sub

Vratite se na radni list i pritisnite kombinaciju ALT+F8 da možete pokrenuti Macro.
Makronaredba će kopirati sve Sheets koje ste specificirali u dotičnu WorkBook.

Ako promijenite dio koda koji određuje naziv kopiranog Sheeta tada možete imati i ovakav rezultat kao na ove dvije slike ispod.

U koliko su Workbook u folderu C:\Temp zaštićene passwordom prije otvaranja tada iskoristite ovu makronaredbu