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

howard

Well-known Member
Joined
Jun 26, 2006
Messages
6,115
Office Version
  1. 2021
Platform
  1. Windows
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



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

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
7,345
Office Version
  1. 2019
Platform
  1. Windows
Hi,
Untested but try following & see if does what you want

VBA Code:
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

Well-known Member
Joined
Jun 26, 2006
Messages
6,115
Office Version
  1. 2021
Platform
  1. Windows
Thanks for the help Dave

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

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
7,345
Office Version
  1. 2019
Platform
  1. Windows
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,492
Messages
5,837,668
Members
430,509
Latest member
steve85215

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
Top