Macro to open up source workwook and copy data from sheet 3 onwards

[howard]

I have code to open up a workbook and to copy and paste the data


I need the code amended to copy data from sheet 3 onwards and paste these into the destination workbook into the same sheet name for eg if source sheet is BR1 Sales, then BR1 Sales in source sheet to be copied into sheet Br1 Sales etc.


your assistance is most appreciated

 Sub copyDataFromSource()
   
    Dim fileSource, lr As Long
   
    Application.ScreenUpdating = False
   
    fileSource = Application.GetOpenFilename
    If fileSource = False Or IsEmpty(fileSource) Then Exit Sub
   
    With Workbooks.Open(fileSource)
       
        With .Sheets("BR1 Sales")
        lr = Range("D" & Rows.Count).End(xlUp).Row
            Range("A6:E" & lr).Copy
            ThisWorkbook.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1).Paste
           
          
     Application.CutCopyMode = False
     End With
       
     .Close False
       
    End With
   
    Application.ScreenUpdating = True
   
End Sub

 

[dmt32]

Hi,
Untested but try following & see if does what you want

Sub copyDataFromSource()
    Dim fileSource
    Dim lr As Long, i As Long
    Dim wbSource As Workbook, wbDest As Workbook
    
    Set wbDest = ThisWorkbook

   
    fileSource = Application.GetOpenFilename
    If fileSource = False Or IsEmpty(fileSource) Then Exit Sub
   
    On Error GoTo myerror
    Application.ScreenUpdating = False
    Set wbSource = Workbooks.Open(fileSource, False, True)
     With wbSource
       For i = 3 To .Worksheets.Count
        With .Worksheets(i)
        lr = .Range("D" & .Rows.Count).End(xlUp).Row
             .Range("A6:E" & lr).Copy wbDest.Worksheets(.Name).Range("A" & Rows.Count).End(xlUp).Offset(1)
         End With
        Next i
     .Close False
     End With
     Application.ScreenUpdating = True
     
myerror:
    If Err <> 0 Then
'sheet name not found
        If Err.Number = 9 Then
            Err.Clear: Resume Next
        Else
'all other errors
           MsgBox (Error(Err)), 48, "Error"
        End If
    End If
End Sub

Dave

 

[howard]

Thanks for the help Dave

I have to make a few minor changes but the code copies the data correctly

 

[dmt32]

Thanks for the help Dave

I have to make a few minor changes but the code copies the data correctly

Most welcome - glad suggestion helped

Dave