Macro to open multiple files and copy data from two seperate sheets and paste these on to to sheets

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows
I have a macro to open multiple files and copy these from 2 specific sheets and paste these one after another on the same sheet names as the source data

When running the macro only the data from the last workbook selected is copied and not from the other workbooks selected


it would be appreciated if someone can kindly amend my code

Code:
 Sub Open_MultipleFiles()
ChDir "C:\downloads\"
Dim LR As Long
Application.DisplayAlerts = False
With Sheets("Sales Data")
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:C" & LR).ClearContents

End With

With Sheets("report Excluding Zero Values")
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A1:C" & LR).ClearContents

End With




Dim fDialog As Object, varFile As Variant
Dim nb As Workbook, tw As Workbook, ts As Worksheet
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .CutCopyMode = False
End With
Set tw = ThisWorkbook
Set ts = tw.ActiveSheet
Set fDialog = Application.FileDialog(3)
ChDir "C:\downloads"
With fDialog
  .Filters.Clear
  .Filters.Add "Excel files", "*.xlsm*"
   .Show
   
   For Each varFile In .SelectedItems
      Set nb = Workbooks.Open(Filename:=varFile, local:=True)
     
     With Sheets("Sales Data")
   .Range("A1:C1000").Copy
    ThisWorkbook.Sheets("Sales Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    ThisWorkbook.Sheets("Sales Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormats

End With
     
      With Sheets("report Excluding Zero Values")
   .Range("A1:C1000").Copy
    ThisWorkbook.Sheets("report Excluding Zero Values").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    ThisWorkbook.Sheets("report Excluding Zero Values").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormats

End With
     
     
     
        nb.Close False
   Next
End With
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .CutCopyMode = True
End With

 Application.DisplayAlerts = True



End Sub





 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows
Thanks Fluff. When using nb.sheets("Sales Data)" no data is pasted

when using the old code , I found the an apostrophe ( ,)was copied into blank cells , which may be causing the issue with only the data being pasted from one workbook
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,848
Office Version
  1. 365
Platform
  1. Windows
Can you answer my question?
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows
Sorry, I missed the question

When stepping through the files are all opened
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,848
Office Version
  1. 365
Platform
  1. Windows
In that case if nothing is copied when using
VBA Code:
   With nb.Sheets("Sales Data")
      .Range("A1:C1000").Copy
      ThisWorkbook.Sheets("Sales Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormats
      ThisWorkbook.Sheets("Sales Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   End With
it suggests that there is no data in that sheet.
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Will check this tonight and revert back to you. Its strange that only one workbooks data from a specific sheet is being copied and not the others
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows
Will upload the files tonight but I need to remove the confidential data, but will leave the formulas intact
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Hi Fluff

See links to Source files below (used only two for this example)



See Link to destination file


Your assistance in checking the code and amending it -have tested on sample data and only one flies data is being copied
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,848
Office Version
  1. 365
Platform
  1. Windows
I get both sets of data. Although because of those formulae on the Sales Data tab, there are a lot of blank rows between each set.
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,784
Office Version
  1. 2019
Platform
  1. Windows
Thanks Fluff. I now see that.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,848
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,112
Messages
5,640,160
Members
417,128
Latest member
Xianter

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