Macro to Copy Data from Source Workbooks where Shets are the same

howard

Well-known Member
Joined
Jun 26, 2006
Messages
6,589
Office Version
  1. 2021
Platform
  1. Windows
I have the following code to open up the source data files and where the sheets are the same to paste these into the same sheets on the destination file. The user havs to select the file twice and then select the macro again to select the next file and select it twice

I would like the code amended to allow the user the select the first file and then be given the open to select another file until no more files to select


Code:
 Sub Copy_Source_Data_SameSheets()
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, desWB As Workbook, ws As Worksheet
    Set desWB = ThisWorkbook
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    flder.Title = "Please select -South Sept Files."
    With flder
    .Filters.Clear
      .Filters.Add "Excel files", "*.xlsm"
      .InitialFileName = "C:\My Documents\*South*Sept*.*"  'change to suit one's needs
      
  
   .Show
  End With
  
    FileChosen = flder.Show
    FileName = flder.SelectedItems(1)
    Set srcWB = Workbooks.Open(FileName)
    For Each ws In srcWB.Sheets
    On Error Resume Next
    
        ws.UsedRange.Copy desWB.Sheets(ws.Name).Range("A1")
    Next ws
    ActiveWorkbook.Close False
End Sub


Your assistance is most appreciated
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
I'm guessing you did not write this code because you are calling the show method twice, which is unn
I have the following code
Did you write the code yourself or is it something you found? I ask because you are calling the show method twice, which is unnecessary.

VBA Code:
Sub Copy_Source_Data_SameSheets()
    Dim flder As FileDialog, FileName As String, FileChosen As Integer, srcWB As Workbook, desWB As Workbook, ws As Worksheet

    Set desWB = ThisWorkbook
    Set flder = Application.FileDialog(msoFileDialogFilePicker)
    MsgBox "When selecting files, hold down the SHIFT or CTRL key to select more than one file. ", vbOKOnly Or vbInformation, Application.Name

    flder.Title = "Please select -South Sept Files."
    With flder
        .Filters.Clear
        .Filters.Add "Excel files", "*.xlsm"
        .InitialFileName = "C:\My Documents\*South*Sept*.*"    'change to suit one's needs
        .AllowMultiSelect = True                               'select multiple files using the SHIFT or CTRL key
    End With

    FileChosen = flder.Show
    If FileChosen = -1 Then
        For FileChosen = 1 To flder.SelectedItems.Count
            FileName = flder.SelectedItems(FileChosen)
            Set srcWB = Workbooks.Open(FileName)
            For Each ws In srcWB.Worksheets
                On Error Resume Next
                ws.UsedRange.Copy desWB.Sheets(ws.Name).Range("A1")
            Next ws
            srcWB.Close False
        Next FileChosen
    Else
        MsgBox "No files were selected", vbOKOnly Or vbInformation, Application.Name
    End If
End Sub
 
Upvote 0
Solution
I found this code on the Internet which I tried to adapt to my needs


Many thanks for your help. You code works perfectly
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,917
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top