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

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,776
Office Version
  1. 2019
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

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
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
5,776
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
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
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
 

Watch MrExcel Video

Forum statistics

Threads
1,129,593
Messages
5,637,294
Members
416,963
Latest member
zazama

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