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
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