PDA

View Full Version : [SOLVED] Copy and paste loop help



Jackel
09-27-2016, 03:12 PM
Hello everyone!

I am semi-new to VBA and really loving it! I am currently trying to create a macro that will look into a folder, copy columns A:H, of all excel files, and paste them into my master file. The rows will never change, just the number of rows. This one macro could save me 4+hours a week of time wasted just copying and pasting. I found TheSpreadsheetGuru's code and am not able to figure out how to modify it to my specific needs. Can someone help show me where to paste the necessary instructions into the code? Or is there an easier way to get this done? Thanks!

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: TheSpreadsheetGuru

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 = "Select A Target Folder"
.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

'Change First Worksheet's Background Fill Blue
wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

'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

offthelip
09-27-2016, 04:00 PM
After a quick look I have got a comment about this code:
It only open files with .xls extension:
'Target File Extension (must include wildcard "*")
myExtension = "*.xls"
You need to change this .xlsx or .xlx? is you have .xlsm files as well


The place to put your code is instead of the lines:
Change First Worksheet's Background Fill Blue
wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

Jackel
09-28-2016, 06:17 AM
Offthelip, Thank you very much for your help! I am trying to work in a sub that sequentially pastes all of the data from each file. If you have any tips, that would be awesome! I have been doing some research and haven't turned anything up yet!

offthelip
09-28-2016, 07:37 AM
You need to open the master workbook that you are copy everything to and save the name by setting "master" to it
You need to keep track of where you are going to write the data from each of the workbooks into the master , do this by setting up an index which increment by 8 ( the number of columns you are coying)
then within the loop you already have where you open each file in turn you first of all detect how many rows you need to copy using then put the code to copy the data and increment the index.
you need to know which worksheet the data is coming from .

Dim master As Workbook, wb As Workbook
'open the master workbook first
Set master = ActiveWorkbook


'
'Loop through each Excel file in folder
Index = 1
Do While myFile <> ""


' select the correct sheet in the workbook
' then detect the last row of data with:
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row


'then copy the data


master.Worksheets("Sheet1").Range(Cells(1, Index), Cells(lastrow, Index + 7)).Value = wb.Worksheets("Sheet1").Range(cells(1,1),cells(lastrow,8)).Value
Index = Index + 8



loop

Jackel
09-28-2016, 08:49 AM
You are the bomb! Thank you for explaining this. I will be working it over the next few days, but I think I have a good understanding about what to do!