PDA

View Full Version : MACRO to Copy all Sheets from Folder



Shywawa
09-28-2018, 02:54 AM
Hi Team,

I want to make a macro that will copy all the sheets of all Workbooks in one Folder without opening them.
I checked the net and wrote a piece of the code below but it only works for one workbook in the folder. I can't seem to make it jump to the next one.
Here is the code:



Sub CopyBooksInFolder()


Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
Dim Wb1 As Workbook


Set Wb1 = ThisWorkbook

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
myfolder = .SelectedItems(1) & "\"
End With


Value = Dir(myfolder)


Do Until Value = ""
If Value = "." Or Value = ".." Then
Else
If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
On Error Resume Next
Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz"
If Err.Number > 0 Then
Else
On Error GoTo 0
For Each sht In ActiveWorkbook.Worksheets
If sht.Visible Then sht.Select (False)
Sheets.Copy After:=Wb1.Sheets(2)

Next sht

End If
Workbooks(Value).Close False
On Error GoTo 0
End If

End If
Value = Dir
Loop


End Sub



one question from my side, if i wanted to make this copy all the sheets in the files i select how different would this have to be?


Kind regards,
Shywawa

Shywawa
09-28-2018, 03:06 AM
ouuups....

Solved it myself.

Just replaced the part below



On Error GoTo 0
For Each sht In ActiveWorkbook.Worksheets
If sht.Visible Then sht.Select (False)
Sheets.Copy After:=Wb1.Sheets(2)
Workbooks(2).Close False

Wb1.Activate

Next sht

End If



However the other question remains.

one question from my side, if i wanted to make this copy all the sheets in the files i select how different would this have to be?