Copy and paste not empty cells from a specific range - excel

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

Related

VBA issues with merged workbook

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

Excel Vba Exit sub function issue

I can't deal with making "Exit Sub" function work the way I need. The goal of macro I'm working on is to import data from another workbook to temporary sheet, do some basic formatting and then copy these data to first empty row in a target sheet.
To avoid duplicating records in the target sheet i need to compare it with the temporary one and exit sub if there are no new records - the compared criteria are dates ('3). It works properly only when there are fresh data, they are copied to the target worsheet excactly the way I want.
On the other hand when there are no fresh records the macro copies the header from the temporary sheet to the target one (to 1st empty row) instead of exit the sub as intended. I use the following code:
Application.ScreenUpdating = False
Dim Fnm As String ' 1. Import raw data from another workbook to temporary sheet
Dim SrcWb As Workbook
Dim DestWb As Workbook
Set DestWb = ThisWorkbook
Fnm = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fnm = "False" Then Exit Sub
Set SrcWb = Workbooks.Open(Fnm)
SrcWb.Sheets("Arkusz1").Range("A:CJ").Copy DestWb.Sheets("Tmp_Data").Range("A:CJ")
SrcWb.Close False
If Arkusz2 Is ActiveSheet Then ' 2. Necessary formatting of temporary sheet
Call CleanData
Else
Arkusz2.Activate
Call CleanData
End If
Dim Max_date1, Max_date2 As Date ' 3. Compare dates in temporary and target sheet - not working when no fresh records
Max_date1 = Application.WorksheetFunction.Max(Arkusz2.Columns("E:E"))
Max_date2 = Application.WorksheetFunction.Max(Arkusz3.Columns("E:E"))
If Max_date1 <= Max_date2 Then
MsgBox "No new data to copy"
Call DlTmpData
Exit Sub
End If
Call ClFltr ' 4. Filter data in temporary sheet
Call CopyTmpData ' 5. Copy filtered data from temporary to target sheet
If Arkusz3 Is ActiveSheet Then ' 6. Formatting data in target sheet
Call ClFrmt
Else
Arkusz3.Activate
Call ClFrmt
End If
Call DlTmpData ' 7. Remove data from temporary sheet

Skipping column names - combining tables from multiple workbooks

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.

Am I setting up the loop correctly to get data from several workbooks into one?

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

How to extract data from multiple closed excel workbooks for placing in a separate workbook in different worksheets through VBA?

(Beginner VBA coder here!)
Does anyone know how to extract multiple, specific cell data from multiple closed workbooks that have the same worksheet format?
I am currently tasked to copy very specific data from certain cells from many different and new (but same format) sources and transfer them into another group of specific cells in an existing masterlist with different worksheets.
This is the code I wished would help, but it is lacking in too many ways as compared to what I need...
Sub Importsheet()
Dim Importsheet As Worksheet
'import worksheet from a closed workbook
Sheets.Add Type:= _
'e.g. directory below
"C:\Users\Loli\Desktop\Testing1.xlsx"
End Sub
This code helps me get the sheets out of the closed source workbook but not the specifically placed cells in the closed source excel. It also can't paste the data in specifically placed cells in different sheets in the destination excel.
It is very difficult to completely understand your requirements as it seems like sometimes you want to copy a range and some other times a single cell, so to point you in the right direction my answer only shows how to open and copy the relevant Sheet into your master workbook to then be able to reference the cell/ranges you want
(I would once you get your data then delete the Worksheet, so that your master doesn't suddenly becomes massive in size):
Sub ImportSheet()
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook") 'open dialog to choose the file you want, you can change this to loop through a folder if they are all in there.
If sImportFile = "False" Then 'check if a file was selected before importing
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile 'open the selected file
Set wbBk = Workbooks(sFile)
With wbBk
If SheetExists("Raw_Data") Then ' you should change this to the date, you can do this easily by using a variable such as if SheetExists(variableDate) then, where variableDate = "12/12/2017" or something similar
Set wsSht = .Sheets("Raw_Data")
wsSht.Copy before:=sThisBk.Sheets("Sheet1") 'copy the worksheet into your master
'WsSht.range("A1:B2").copy Destination:=sThisBk.Sheets("Temp").Range("A1").paste xlpastevalues 'use this to copy a specified range in this case A1:B2 to a sheet in master workbook called Temp A1
Else
MsgBox "There is no sheet with name :Raw_Data in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function

Resources