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

[howard]

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

 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

 

[rlv01]

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.

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

 

[howard]

I found this code on the Internet which I tried to adapt to my needs


Many thanks for your help. You code works perfectly