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
6,561
Office Version
  1. 2021
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





 
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
 
Upvote 0

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sorry, I missed the question

When stepping through the files are all opened
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
Will upload the files tonight but I need to remove the confidential data, but will leave the formulas intact
 
Upvote 0
Upvote 0
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.
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,558
Messages
6,114,297
Members
448,564
Latest member
ED38

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
Back
Top