I am trying to combine a table from multiple workbooks and create a new master workbook which contains all the extracted tables. My current code successfully copies and pastes data from each workbook but still have a few issues and couldn't figure them out by myself.
First, I want to skip the first row, which is just variable names, starting from the second source file. I still need it from the first source file so that my master workbook can have column names in the first row. I tried to achieve this using some loops but it didn't work. Which part do I need to update in order to do this?
Second, is there a way to create an additional column in the master workbook as a flag that shows the source file of data when I copy and paste a table from each individual source file to the master?
For example, if a source excel file is named "file123", the flag column would contain "file123" as its value.
Lastly, in the line of my code where it pastes the copied value,
MaWS.Range("A12785").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
I randomly assigned a big number "A12785" but how do I determine this value? Can I just keep it random?
FYI, here is my current code.
My master workbook is named "Master" and has a sheet named "Summary"
My source files have the table in the "data" tab.
Option Explicit
Sub Merge()
Dim SrPath As String
Dim MaPath As String
Dim SrName As String
Dim MaName As String
Dim SrTemplate As String
Dim MaTemplate As String
Dim SrWS As Worksheet
Dim MaWS As Worksheet
'Define folders and filenames
SrPath = "C:\Users\Documents\Test\"
MaPath = "C:\Users\Documents\Test\Master\"
SrTemplate = "*.xlsx" '
MaTemplate = "Master.xlsm"
'Open the template file and get the Worksheet to put the data into
MaName = Dir(MaPath & MaTemplate)
Workbooks.Open SumPath & SumName
Set MaWS = ActiveWorkbook.Worksheets("Summary")
'Open each source file, copying the data from each into the template file
SrName = Dir(SrPath & SrTemplate) 'Retrieve the first file
Do While SrName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open SrPath & SrName
Set SrWS = ActiveWorkbook.Worksheets("data")
'Copy the data from the source and paste at the end of Summary sheet
SrWS.Range("A1:N35").Copy
sumWS.Range("A12785").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
'Close the current sourcefile and get the next
Workbooks(SrName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop
'Now all sourcefiles are copied into the Template file. Close and save it
Workbooks(MaName).Close SaveChanges:=True
End Sub
Thank you.
Related
I am trying to create a template automating tasks for a user that is not very familiar with Excel. To start, it grabs the files from a folder on the users desktop (OneDrive connection if that matters), merges them into new sheets of the template and renames the sheets to the appropriate names. Second, it should copy the used range of each sheet and paste it into tables (connected to pivots and graphs).
The problem I'm having is that after the merge, but before the paste into tables, I need to insert some calculated columns. When I try to insert the formula and copy it down using the macro, it pastes up. As in, if I place the formula in H2, it copies up to H1 instead of the used rows range.
Funny thing is the code works perfectly on the original workbook, but not after the merge. There may be a better way to merge them, but I haven't found it. Any help is appreciated!
Here is my code:
To merge the workbooks-
Sub Combine_Workbooks()
'Combines all the workbooks in folder named FLEET DATA DUMP on desktop of user.
Dim Path As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
'Update this to username
Path = "C:\Users\hsthompson\OneDrive - Quanta Services Management Partnership, L.P\Desktop\FLEET DATA DUMP\"
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Sheets("CODE").Activate
Application.ScreenUpdating = True
End Sub
To Rename Sheets (Separated due to issues with object issues)
Sub Rename_Sheets()
'Renames sheets to link to pivot tables.
Sheets("Sheet1").Name = "DLH"
Sheets("RentalEquipmentAnalysis_Assigne").Name = "Rentals"
Sheets("Report_AssetDetailExport - 2023").Name = "Assets"
End Sub
To alter the sheet named Rentals to use column H as a calculated column
Sub Rentals()
Dim UsedRws As Long
UsedRws = Cells(Rows.Count, "A").End(xlUp).End(xlUp).Row
Sheets("Rentals").Range("H2:H" & UsedRws).FormulaLocal = "=TODAY()-WEEKDAY(TODAY())"
MsgBox UsedRws
Sheets("Rentals").Range("H1") = "Week Ending"
End Sub
I have tried updating the code to several different variations:
Range vs Cells
Double .End(xlUp)
Tried xlDown, but that pasted the formula down to the bottom of the sheet 104000
Tried copying and pasting manually into the workbook and the code worked fine.
Formula vs FormulaLocal
Etc
I am setting up VBA code which does the following when run:
Runs a loop to open Excel files in a folder, one by one
Every time that an Excel file is opened, a password unprotects the worksheet and unmerges cells
Once the cells are unmerged, the data from the Excel file is copied and pasted to specific cells in the workbook where the VBA code is originally saved/stored
Upon pasting the data, the opened Excel workbook from the loop now closes (not necessary to save), and the next workbook is opened, where the next set of data is placed one row below the previous row
The VBA code is run from a workbook which always remains open, we can call it "Workbook 1.xlsm" In this instance for the code below, the use of wbPaste as the active workbook is intended to reference "Workbook 1.xlsm". Because the name of the workbook is going to change every month that this is run, I wanted to declare a workbook by using a naming convention that would reference the name, regardless of what the workbook is called.
The files that are in the folder can have various names, and could be in the hundreds of total files. I have declared most of the variables and have had success in getting the Excel workbooks to open from the folder. Unprotecting the sheet, and unmerging the cells has given some problems, however. I think that the issue that I am experiencing comes with looping the opening of the workbooks and which workbook is considered "active" at the time.
Sub OpenFilesForExtraction()
'declaration of variables
Dim myFolder As String
Dim myFile As String
Dim wbCopy As Workbook
Dim wbPaste As Workbook
Dim lastRow As Long
'setting up name of folder and file type (any Excel file in folder) for the loop
myFolder = "C:\Users\Me\Desktop\Folder 1\"
myFile = Dir(myFolder & "*.xl??")
lastRow = 3
'start of loop
Do While myFile <> ""
Workbooks.Open fileName:=myFolder & myFile
'wbCopy is the Excel file that gets unprotected, unmerged and data is copied from. wbPaste will be where the data gets copied to. wbPaste is referencing the workbook where the macro is stored. By declaring these files in the loop, wbCopy should take on the name of the next file opening from the folder
Set wbCopy = Workbooks(myFile)
Set wbPaste = ActiveWorkbook
'Unprotecting and unmerging from the file wbCopy, that was opened by the loop statement
wbCopy.Unprotect Password:="Password1"
wbCopy.Unprotect
Range("C15:E15").Select
Selection.UnMerge
Range("H15:J15").Select
Selection.UnMerge
Range("C17:E17").Select
Selection.UnMerge
Range("B23:C23").Select
Selection.UnMerge
Range("B29:C29").Select
Selection.UnMerge
Range("B31:J37").Select
Selection.UnMerge
'Copying and pasting the information from the files that are being opened to the file wbPaste. Note that the range for where the value is pasted is determined by the value of "lastRow" variable, which is designed to paste information starting with the cells in row 3, then moving to row 4, row 5, and so on....
wbCopy.Range("C13").Value = wbPaste.Range("A" & lastRow).Value
wbCopy.Range("C15").Value = wbPaste.Range("B" & lastRow).Value
wbCopy.Range("H15").Value = wbPaste.Range("D" & lastRow).Value
wbCopy.Range("C17").Value = wbPaste.Range("I" & lastRow).Value
wbCopy.Range("J17").Value = wbPaste.Range("H" & lastRow).Value
wbCopy.Close
lastRow = lastRow + 1
myFile = Dir
Loop
End Sub
The program reaches a point where it will open up the first file from the folder, however, I get an immediate error after that. I think that there are two potential reasons.
First, I am not certain if I should use anything related to ActiveWorkbook. The reason why is because as I loop through opening the Excel documents in the folder, the VBA code may not understand which is meant to be the ActiveWorkbook at certain times.
Second, the Unmerging and copy/paste of values is where this will stop the program. I have had some chances to allow the cells to unmerge, but I think it came at the cost of calling out the wbCopy file as an ActiveWorkbook, when it really isn't meant to be called out as an active workbook.
There are a number of issues here
Relying on ActiveWorkbook when opening books changes what's active
Using Select
Your copy/paste is reversed
Unnecessary second Unprotect
Not using ThisWorkbook (you say you specifically want to paste into the book containing the VBA code)
Refering to Range's on Workbooks, instead of Worksheets
Your code, refactored
Sub OpenFilesForExtraction()
'declaration of variables
Dim myFolder As String
Dim myFile As String
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim lastRow As Long
'setting up name of folder and file type (any Excel file in folder) for the loop
myFolder = "C:\Users\Me\Desktop\Folder 1\"
myFile = Dir(myFolder & "*.xl??")
lastRow = 3
'start of loop
Set wsPaste = ThisWorkbook.Worksheets("NameOfSheetToPasteOn")
Do While myFile <> vbNullString
'wbCopy is the Excel file that gets unprotected, unmerged and data is copied from. wbPaste will be where the data gets copied to. wbPaste is referencing the workbook where the macro is stored. By declaring these files in the loop, wbCopy should take on the name of the next file opening from the folder
Set wbCopy = Workbooks.Open(Filename:=myFolder & myFile)
'Unprotecting and unmerging from the file wbCopy, that was opened by the loop statement
wbCopy.Unprotect Password:="Password1"
Set wsCopy = wbCopy.Worksheets("NameOfSheetToCopyFrom")
With wsCopy
'wbCopy.Unprotect
.Range("C15:E15").UnMerge
.Range("H15:J15").UnMerge
.Range("C17:E17").UnMerge
.Range("B23:C23").UnMerge
.Range("B29:C29").UnMerge
.Range("B31:J37").UnMerge
'Copying and pasting the information from the files that are being opened to the file wbPaste.
'Note that the range for where the value is pasted is determined by the value of "lastRow" variable,
'which is designed to paste information starting with the cells in row 3, then moving to row 4, row 5, and so on....
wsPaste.Range("A" & lastRow).Value = .Range("C13").Value
wsPaste.Range("B" & lastRow).Value = .Range("C15").Value
wsPaste.Range("D" & lastRow).Value = .Range("H15").Value
wsPaste.Range("I" & lastRow).Value = .Range("C17").Value
wsPaste.Range("H" & lastRow).Value = .Range("J17").Value
End With
wbCopy.Close False
lastRow = lastRow + 1
myFile = Dir
Loop
End Sub
I have never don't VBA scripting, or macros.
However I need to copy pasting a lot of excel documents into one. So I was wondering how I could implement the following (or what direction to head):
I need to copy a table of x rows and y columns but there are many empty rows. And a lot of rows are merged. I need to copy this to another file and unmerge the rows and copy the content to all of the merged columns.
There are multiple files like this and need to go into one file. Each file has varying amount of sheets.
If anything is there anyways I can just created a macro to copy and paste only non empty columns and unmerge the merged columns and have the same data between all the merged rows?
This is a partial answer, which does not address the processing of the individual sheets. It does give you a framework to start with.
Sub Process_Workbooks()
'Process a Collection of workbooks
Dim arrPathandFile, FilePointer As Long
Dim strPathAndFile As String
Dim bkSource As Workbook, shInput As Worksheet
Dim bkDestination As Workbook, shResult As Worksheet
Dim myPath, PathandFile As String
arrPathandFile = Application.GetOpenFilename("Audit Files (*.xls*), *.xlsx, All Files (*.*), *.*", , "Select Workbooks to process", "", True)
' user cancels file selection
If Not IsArray(arrPathandFile) Then Exit Sub
'Create a place to put the results
Set bkDestination = Workbooks.Add
'For each file in the collectin
For FilePointer = 1 To UBound(arrPathandFile)
strPathAndFile = arrPathandFile(FilePointer)
'Open the workbook
Set bkSource = Workbooks.Open(strPathAndFile)
'process each worksheet
For Each shInput In bkSource.Sheets
Set shResult = bkDestination.Sheets.Add
shResult.Name = shInput.Name & "(" & FilePointer & ")"
'figure out the source range to copy
shInput.Range("A1:Z900").Copy Destination:=shResult.Range("A1")
'now do stuff to the sheet in the destination.
Call Do_Stuff_To_sheets(shInput)
'repeat for each sheet in the workbook
Next shInput
bkSource.Close
'repeat for each workbook selected
Next FilePointer
'save the results
bkDestination.SaveAs myPath & "NewFilename.xlsx"
End Sub
Private Sub Do_Stuff_To_sheets(mySheet As Worksheet)
'process each sheet to unmerge and defrag columns
End Sub
Sub VBA_Read_External_Workbook()
'''''Define Object for Target Workbook
Dim Target_Workbook As Workbook
Dim Source_Workbook As Workbook
Dim Target_Path As String
'''''Assign the Workbook File Name along with its Path
'''''Change path of the Target File name
Target_Path = "C:\Users\User\Desktop\Excel VBA\Working Sample Folder\MAY 2017 Summary- Atlas work.xlsx"
Set Target_Workbook = Workbooks.Open(Target_Path)
Set Source_Workbook = ThisWorkbook
'''''With Target_Workbook object now, it is possible to pull any data from it
'''''Read Data from Target File
Target_Data = Target_Workbook.Sheets(1).Range("A1:B3")
Source_Workbook.Sheets(2).Range("A1:B3") = Target_Data
'''''Update Target File
Source_data = Source_Workbook.Sheets(1).Range("A1:B3")
Target_Workbook.Sheets(1).Range("A1:B3") = Source_data
'''''Close Target Workbook
Source_Workbook.Save
Target_Workbook.Save
Target_Workbook.Close False
'''''Process Completed
MsgBox "Task Completed"
End Sub
I've been modifying this code that i found in this website to use it for copying the specific data in a specific format.
What I need some guidance is to add a loop to get the data from the files that will be put in a folder.Files that needed to be read
So my questions
Basically, I already set the specific range of data that needed to be copied and paste on my destination files. But instead of keep changing the target path, is there a way to put a loop that it will auto jump to the next workbook and get those values?
I found out that using this method to transfer the data, it doesn't transfer the data nature which for example if it is in time format at the source file, when the VBA execute and update the destination file, the value is not in the same format and all are pasted in general format.
Is it possible to loop the update where it will auto jump to the next row to paste the data?
I tried to google some of the VBA codes but the answer is very vague.
Appreciate any input from your experiences.
1)Basically, I already set the specific range of data that needed to be copied and paste on my destination files. But instead of keep changing the target path, is there a way to put a loop that it will auto jump to the next workbook and get those values?
This will get you started
Dim MyFolder As String
Dim StrFile As String
Dim flName As String
'~~> Change this to the relevant folder
MyFolder = "c:\MyFolder\"
StrFile = Dir(MyFolder & "*.xls*")
'~~> Loop through all excel files in the folder
Do While Len(StrFile) > 0
flName = MyFolder & StrFile
'~~> Open the workbook
Set wb = Workbooks.Open(flName)
'
'~~> Rest of your code
'
wb.Close (False)
StrFile = Dir
Loop
2)I found out that using this method to transfer the data, it doesn't transfer the data nature which for example if it is in time format at the source file, when the VBA execute and update the destination file, the value is not in the same format and all are pasted in general format.
The code is directly setting the value and hence the formats are not copied. You need to .Copy and .Pastespecial instead of directly setting the value. Record a macro to see how .Copy and .Pastespecial work. or read up on
Range.PasteSpecial Method (Excel)
3)Is it possible to loop the update where it will auto jump to the next row to paste the data?
Find the last row and then do a copy paste to that row. Please see the below link to find the last row.
Finding Last Row
I have a workbook containing one worksheet ("DB Output" or Sheet 34) which I would like to copy to several (around 45) files in within the same folder.
None of the target files have an existing sheet named "DB Output" - the objective is to find a way to insert a copy of this sheet, forumlas and all, into each one.
The range of cells on that sheet that needs to be copied to a sheet of the same name in each book is A1:PE5
The sheet contains references to cells in the book it is currently in, however as the files which I am seeking to copy the worksheet to all share the same template, I want the references to be to the local file, not the original one.
I've tried looking at RDBMerge, however it seems that is for merging sheets, and while I do want to do that, it will not help me do it multiple times quickly.
Likewise I have looked on SO for similar situations, this is the closest, however my attempts to adapt that code have failed as I only have a single workskeet. Never the less, as it is always useful to inlcude what you have already tried, here is my existing attempt:
Option Explicit
Public Sub splitsheets()
Dim srcwb As Workbook, trgwb As Workbook
Dim ws As Worksheet, t1ws As Worksheet
Dim rng1 As Range
Dim trgnm As String
Dim fpath As String
Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
fpath = "C:/file/path/"
Set srcwb = ThisWorkbook
For Each ws In srcwb.Worksheets
trgnm = ws.Name
'--> Change A1:B3 to the range to be copied to inside page
Set rng1 = srcwb.Sheets(trgnm).Range("A1:PE5")
Set trgwb = Workbooks.Open(fpath & trgnm & ".xlsm")
With trgwb
Set t1ws = .Sheets("DB Output")
End With
'--> Change A1:B3 to the range where you want to paste
rng1.Copy t1ws.Range("A1:PE5")
trgwb.Close True
Next
Application.ScreenUpdating = True
End Sub
However this starts with the first sheet in the workbook that contains DB Output (the sheet to be copied) and gives an error that "NameOfSheet1.xlsm" does not exist in that directory (which it does not).
Any help is much appreciated.
This should copy from the active workbook to all files in a directory. If you need help modifying it to fit your specific use let me know!
Edit: fixed code to only copy A1:PE5 and save each workbook.
Sub Example()
Dim path As String
Dim file As String
Dim wkbk As Workbook
path = "C:\Test\"
file = Dir(path)
Application.DisplayAlerts = False
Do While Not file = ""
Workbooks.Open (path & file)
Set wkbk = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "DB Output"
ThisWorkbook.Sheets("DB Output").Range("A1:PE5").Copy Destination:=wkbk.Sheets("DB Output").Range("A1")
wkbk.Save
wkbk.Close
file = Dir
Loop
Application.DisplayAlerts = True
End Sub
Please note that I did not add error handling so this could break if the active workbook is included in the directory you are trying to copy or if a sheet with the same name already exists in the workbook. If this is an issue let me know and I will add error handling.