47541

Copy and paste data from multiple workbooks to a worksheet in another Workbook

Question:

I hope you can help. I currently have a piece of code see below. What I would like it to do is allow a user to select folder that contains workbooks. Then open each workbook select a sheet named "SearchCaseResults" from each workbook copy the data from each "SearchCaseResults" from the 2nd row down to the last used row, and paste this data into a worksheet called "Disputes" located in a different workbook in another folder.

So in PIC 1 you can see three Workbooks England, England_2 and England_3 each of these workbooks contain a worksheet "SearchCaseResults" So what I essentially need the code to do is loop through the folder open England workbook select the worksheet "SearchCaseResults" copy the data on this worksheet from row 2 to last used row then paste to the "Disputes" worksheet in the other workbook, in another folder, then select the next Workbook England_2 select the worksheet "SearchCaseResults" in this workbook copy the data on this worksheet from row 2 to last used row then <strong>PASTE IT BELOW</strong> the data copied from the previous worksheet(England) in the "Disputes" Worksheet and then continue with this copy and paste process until there are no more Workbooks left in the folder.

At the moment the code I have is opening up the workbooks, which is fine and selecting/activating the "SearchCaseResults" worksheet from each, but it is only coping cell A2 from the England sheets and then it is just pasting the data from the last sheet into the destination Worksheet.(I suspect the data from previous sheets is being pasted over) Can my code be amended to copy the data from each "SearhCaseResults" sheet from A2 to last used row and then Pasted into "Disputes" sheet underneath each other.

Here is my code so far as always any and all help is greatly appreciated.

CODE

Sub LoopAllExcelFilesInFolder() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'SOURCE: www.TheSpreadsheetGuru.com Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "C:\Users\CONNELLP\Desktop\Claire Macro\Copy and Paste Disputes\Report Sheet\" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xls*" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) 'Loop through each Excel file in folder Do While myFile <> "" 'Set variable equal to opened workbook Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Ensure Workbook has opened before moving on to next line of code DoEvents 'Copy data on "SearchCaseResults" sheet to "Disputes" Sheet in other workbook Dim lRow As Long Dim ws2 As Worksheet lRow = Range("A" & Rows.Count).End(xlUp).Row Set y = Workbooks.Open("C:\Users\CONNELLP\Desktop\Claire Macro\Copy and Paste Disputes\Report Sheet") Set ws2 = y.Sheets("Disputes") wb.Worksheets("SearchCasesResults").Range("A2" & lRow).Copy With y ws2.Range("A2").PasteSpecial End With 'Save and Close Workbook wb.Close SaveChanges:=True 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

<strong>I should point out that the code above is run from a separate workbook with a command button.</strong>

See pic 2

PIC 1

<a href="https://i.stack.imgur.com/9T1ka.png" rel="nofollow"><img alt="enter image description here" class="b-lazy" data-src="https://i.stack.imgur.com/9T1ka.png" data-original="https://i.stack.imgur.com/9T1ka.png" src="https://etrip.eimg.top/images/2019/05/07/timg.gif" /></a>

PIC 2

<a href="https://i.stack.imgur.com/7B5dG.png" rel="nofollow"><img alt="enter image description here" class="b-lazy" data-src="https://i.stack.imgur.com/7B5dG.png" data-original="https://i.stack.imgur.com/7B5dG.png" src="https://etrip.eimg.top/images/2019/05/07/timg.gif" /></a>

Answer1:

Try this. I have corrected a few syntax errors. It's not clear if you are just copying data from column A, which I have assumed, but if not the copy line will need to be amended.

Sub LoopAllExcelFilesInFolder() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'SOURCE: www.TheSpreadsheetGuru.com Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim lRow As Long Dim ws2 As Worksheet Dim y As Workbook 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "C:\Users\CONNELLP\Desktop\Claire Macro\Copy and Paste Disputes\Report Sheet\" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xls*" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) Set y = Workbooks.Open("C:\Users\CONNELLP\Desktop\Claire Macro\Copy and Paste Disputes\Report Sheet") Set ws2 = y.Sheets("Disputes") 'Loop through each Excel file in folder Do While myFile <> "" 'Set variable equal to opened workbook Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Copy data on "SearchCaseResults" sheet to "Disputes" Sheet in other workbook With wb.Sheets("SearchCaseResults") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A2:M" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2) End With wb.Close SaveChanges:=True 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

Recommend

  • How do I use RefersToRange?
  • What notice does a user get from distributed Edge Chromium Extension with an MSI through the registr
  • Why \\z for regular expression doesn't work for me?
  • Add Sass option after creation of a project
  • (FunctionClauseError) no function clause matching in Access.get/3
  • How to get second highest value among multiple columns in SQL
  • TinyMCE - undefined 'e','j','t' when loading for a second time in fanc
  • how to add fade out effect in Div of text in HTML5
  • Work with FileMaker Pro FP7 Files
  • An error from Azure DevOps Build: Could not locate the assembly “System.ComponentModel.Annotations”
  • Linq cannot convert from 'System.Collections.Generic.IEnumerable' to 'string[]'
  • All-to-all setdiff on two numeric vectors with a numeric threshold for accepting matches
  • Does mingw32-make be renamed to make?
  • A “regex for words” (semantic replacement) - any example syntax and libraries?
  • Visual Studio 2012 C++ compile error with Boost Signal2
  • Assigning variable and using it in range
  • Importing Excel Charts from Excel to PowerPoint causes `RPC_E_SERVERFAULT` on some machines
  • How to determine if a coordinate is inside SVG Close Path?
  • JPA EntityManager and JavaFx [duplicate]
  • Html Multiple Input Elements With Same Name
  • how can i close the resultSet, prepareStatement, conn in several methods below to avoid rs close and
  • Create One-To-One relationship between table and view in EF4?
  • Move elements from a listbox to another
  • read.table returning character matrix, would like numeric
  • Showing image on a acro text field position
  • Getting Microsoft Calibri font on Amazon EC2 ubuntu
  • Why do you need 2 Javascript files for cross-platform Cordova plugin?
  • How to make Rss News Reader application in android …? [closed]
  • SQL Server 2012 not showing unicode character in results
  • Ember.js + JQuery-UI Tooltip - Tooltip does not reflect the model / controller changes
  • Change cell value based on cell color in google spreadsheet
  • Android: Unable to detect vertical plane
  • Debug `Unexpected end of JSON input Error` on content script
  • How to encrypt Connectionstring written in web.config from codebehind?
  • Bad automatic Triangulation with Mayavi for coloring a surface known only by its corner
  • Apple Mach-O Linker error (“duplicate symbol”)
  • Angular FormGroup won't update it's value immediately after patchValue or setValue