Copying data from multiple sheets using VBA

[mrnassaro]

Hello Experts!

I am working with the following VBA is works great for me. however, I am trying to do the following but unable to:

1- when I run this VBA for the first time it works. I want this to be running into new sheet that I could save, because I want this to be a master file that can be updated every time. and if possible to run the file directly when it is opened? ( I am trying to make this file as easy to non excel people)
2- can I only copy the unhidden sheets?

VBA Code:

Sub mergeFiles()
    'Merges all files in a folder to a main file.
   
    'Define variables:
    Dim numberOfFilesChosen, i As Integer
    Dim tempFileDialog As FileDialog
    Dim mainWorkbook, sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet
   
    Set mainWorkbook = Application.ActiveWorkbook
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
   
    'Allow the user to select multiple workbooks
    tempFileDialog.AllowMultiSelect = True
   
    numberOfFilesChosen = tempFileDialog.Show
   
    'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.Count
       
        'Open each workbook
        Workbooks.Open tempFileDialog.SelectedItems(i)
       
        Set sourceWorkbook = ActiveWorkbook
       
        'Copy each worksheet to the end of the main workbook
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
        Next tempWorkSheet
       
        'Close the source workbook
        sourceWorkbook.Close
    Next i
    End Sub

 

[NdNoviceHlp]

I don't really understand #1 other than U could run the sub from a workbook open event? This seems like it should work for #2. HTH. Dave

'Copy each worksheet to the end of the main workbook
For Each tempworksheet In sourceWorkbook.Worksheets
If tempworksheet.Name.Visible = True Then
tempworksheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
End If
Next tempworksheet

 

[mrnassaro]

I don't really understand #1 other than U could run the sub from a workbook open event? This seems like it should work for #2. HTH. Dave

'Copy each worksheet to the end of the main workbook
For Each tempworksheet In sourceWorkbook.Worksheets
If tempworksheet.Name.Visible = True Then
tempworksheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
End If
Next tempworksheet

Thank you very much for replying.

what I wanted to say is that i want the file to hold the code, but the merging of docs happen in new excel sheet that could be saved by itself. and this file could be run again for different or updated versions of the source files.

 

[NdNoviceHlp]

So the code is in your "mainWorkbook" and you want to run the sub to create a new wb with the copied sheets from all of the selected wbs. Can U provide a file path and wb name for the new wb. What happens the 2nd time you run the code ie. is there another wb created and renamed or do you get rid of the previous data in the previosly created wb? Dave

 

[mrnassaro]

So the code is in your "mainWorkbook" and you want to run the sub to create a new wb with the copied sheets from all of the selected wbs. Can U provide a file path and wb name for the new wb. What happens the 2nd time you run the code ie. is there another wb created and renamed or do you get rid of the previous data in the previosly created wb? Dave

thank you for your patience and answering my questions

the file path would be my desktop: C:\Users\NassarM\Desktop\
Name for the WB: Roll Up

when i run the code the 2nd time, I got an error "400"

Moe

 

[NdNoviceHlp]

Hi Moe. It seems I had the syntax with the code wrong before. Seems it should have been..

If SourceWorkbook.Sheets(tempworksheet.Name).visible = True Then

U can trial this code for a completed project. Dave

Option Explicit
Sub test()
Dim ObjWorkbook As Object, ObjWorksheet As Object, sht As Worksheet
Dim SourceWorkbook As Object, TempFileDialog As Variant, NumberofFilesChosen As Variant
Dim i As Integer, cnt As Integer, PageCollect As Collection, tempworksheet As Worksheet
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'remove current sheets
Set ObjWorkbook = Workbooks.Open("C:\Users\NassarM\Desktop\Roll Up.xlsm")
'change sheet1 to TEMP so can delete later
Set ObjWorksheet = ObjWorkbook.Worksheets(1)
With ObjWorksheet
.Name = "TEMP"
End With
For Each sht In ObjWorkbook.Sheets
If sht.Name <> "TEMP" Then
sht.Delete
End If
Next sht

'Allow the user to select multiple workbooks
Set TempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
TempFileDialog.AllowMultiSelect = True
NumberofFilesChosen = TempFileDialog.Show

'Loop through all selected workbooks
For i = 1 To TempFileDialog.SelectedItems.Count
'Open each workbook
Workbooks.Open TempFileDialog.SelectedItems(i)
Set SourceWorkbook = ActiveWorkbook
Set PageCollect = New Collection
'copy sheets using collection
For Each tempworksheet In SourceWorkbook.Worksheets
If SourceWorkbook.Sheets(tempworksheet.Name).visible = True Then
PageCollect.Add SourceWorkbook.Sheets(tempworksheet.Name)
End If
Next tempworksheet
For cnt = 1 To PageCollect.Count
PageCollect(cnt).Copy ObjWorkbook.Sheets(cnt)
Next cnt
'Close the source workbook
SourceWorkbook.Close SaveChanges:=False
Next i
'remove temp sheet and save
ObjWorkbook.Worksheets("TEMP").Delete
ObjWorkbook.Close SaveChanges:=True

ErrHandler:
If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "Error"
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Set SourceWorkbook = Nothing
Set ObjWorksheet = Nothing
Set ObjWorkbook = Nothing
End Sub

 

[mrnassaro]

Hi Moe. It seems I had the syntax with the code wrong before. Seems it should have been..

If SourceWorkbook.Sheets(tempworksheet.Name).visible = True Then

U can trial this code for a completed project. Dave

Option Explicit
Sub test()
Dim ObjWorkbook As Object, ObjWorksheet As Object, sht As Worksheet
Dim SourceWorkbook As Object, TempFileDialog As Variant, NumberofFilesChosen As Variant
Dim i As Integer, cnt As Integer, PageCollect As Collection, tempworksheet As Worksheet
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'remove current sheets
Set ObjWorkbook = Workbooks.Open("C:\Users\NassarM\Desktop\Roll Up.xlsm")
'change sheet1 to TEMP so can delete later
Set ObjWorksheet = ObjWorkbook.Worksheets(1)
With ObjWorksheet
.Name = "TEMP"
End With
For Each sht In ObjWorkbook.Sheets
If sht.Name <> "TEMP" Then
sht.Delete
End If
Next sht

'Allow the user to select multiple workbooks
Set TempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
TempFileDialog.AllowMultiSelect = True
NumberofFilesChosen = TempFileDialog.Show

'Loop through all selected workbooks
For i = 1 To TempFileDialog.SelectedItems.Count
'Open each workbook
Workbooks.Open TempFileDialog.SelectedItems(i)
Set SourceWorkbook = ActiveWorkbook
Set PageCollect = New Collection
'copy sheets using collection
For Each tempworksheet In SourceWorkbook.Worksheets
If SourceWorkbook.Sheets(tempworksheet.Name).visible = True Then
PageCollect.Add SourceWorkbook.Sheets(tempworksheet.Name)
End If
Next tempworksheet
For cnt = 1 To PageCollect.Count
PageCollect(cnt).Copy ObjWorkbook.Sheets(cnt)
Next cnt
'Close the source workbook
SourceWorkbook.Close SaveChanges:=False
Next i
'remove temp sheet and save
ObjWorkbook.Worksheets("TEMP").Delete
ObjWorkbook.Close SaveChanges:=True

ErrHandler:
If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "Error"
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Set SourceWorkbook = Nothing
Set ObjWorksheet = Nothing
Set ObjWorkbook = Nothing
End Sub

thank you so much for the code! I am trying to copy it into my excel but I am getting a small screen with "error". I don't know why

 

[NdNoviceHlp]

Trial the whole code. It tested OK with me. Dave

 

[mrnassaro]

Trial the whole code. It tested OK with me. Dave

i copied the whole code into the VBA editor but I get this small box. Did I copy it wrong?

 

[NdNoviceHlp]

That error box is generated by the code. The file "C:\Users\NassarM\Desktop\Roll Up.xlsm" must exist. You can remove the "on error goto errorhandler" line of code to find out what line of code is crashing. Dave