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
Related
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.
I'm a new VBA learner. I would be appreciated if you help me with this problem:
I have two workbooks. On one of those, I have a userForm that all the information comes from that. comp is one of the data entry from that. By entering this information I want to create a new workbook with this name and also on the active sheet one cell get the same info. in this order, I've made this code so far. But I also want two more things that I don't know how to do it; first I want that cell in the active sheet to be linked with the new workbook. And second I need the cell right next to the previous one to get the same value as one specific cell in the new workbook ("h12").
Dim path As String
Dim filename1 As String
Workbooks.Open ("C:\Users\payam\Desktop\temp.xlsx")
path = "C:\Users\payam\Desktop\"
filename1 = comp.Text
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=path & filename1 & ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Worksheets("sheet1").Range("a2") = comp.Text
ActiveWorkbook.Close
eRow = Sheet7.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("Sheet7").Cells(eRow, 1).Value = comp.Text
I am trying to copy whatever selected sheet (notwithstanding the name of the sheet) within the same workbook. First, I have tried the code of copying and renaming a new sheet (with formulas) that I found elsewhere. It is working well:
Public Sub CopySheetAndRename()
Dim newName As String
On Error Resume Next
newName = InputBox("Enter the name for the copied worksheet")
If newName <> "" Then
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = newName
End If
End Sub
However, I would just like to have the newly created sheet without formulas. I tried to add the lines like: ActiveSheet.PasteSpecial Paste:=xlPasteValues
but it is not working at all. I have read also this post Copy Excel sheet to another excel book without formulas without any result.
Thank you for your help!
Stanley
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