Guys, I have the below code that does a really good job of consolidating worksheets within a given workbook. This works well when I need to consolidate the data in specific columns but the problem that I am facing is that I am needing to consolidate daily invoices and while some of the data such as SKU#, Model#, Cost, Quantity, etc... are formatted so that they work well with the below code, the Invoice Date, PO Number, and Invoice Number are only on the commercial invoices 1 time and I am unable to add them to my consolidated flat file using the code below. Below is an example of the final product that i am trying to achieve. Essentially pulling data from the invoice sheet and putting it into a flat file to upload into a program. I know there are many ways to do this but this is the way I have started and what has worked well up to this point.
Sub ConsolidateSheets()
'Merge all sheets in a workbook into one summary sheet (stacked)
'Data is sorted by a specific column name
Dim cs As Worksheet, ws As Worksheet
Dim LR As Long, NR As Long, sCol As Long
Dim sName As Boolean, SortStr As String
Application.ScreenUpdating = False
'From the headers in data sheets, enter the column title to sort by when finished
SortStr = "Statement Date"
'Add consolidation sheet if needed
'If Not Evaluate("ISREF(Consolidate!A1)") Then _
'Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Pivot EI YTD"
'Option to add sheet names to consolidation report
sName = MsgBox("Add sheet names to consolidation report?", vbYesNo + vbQuestion) = vbYes
'Setup
Set cs = ActiveWorkbook.Sheets("EI YTD")
cs.Cells.ClearContents
NR = 1
'Process each data sheet
For Each ws In Worksheets
If ws.Name <> cs.Name And _
ws.Name <> "Pivot EI YTD" Then
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
'customize this section to copy what you need
If NR = 1 Then
'copy titles and data to start the consolidation, edit row as needed for source of titles
ws.Range("A1", ws.Cells(1, Columns.Count).End(xlToLeft)).Copy
If sName Then
cs.Range("B1").PasteSpecial xlPasteAll
Else
cs.Range("A1").PasteSpecial xlPasteAll
End If
NR = 2
End If
ws.Range("A2:BB" & LR).Copy 'copy data, edit as needed for the start row
If sName Then 'paste and add sheet names if required
cs.Range("B" & NR).PasteSpecial xlPasteValuesAndNumberFormats
cs.Range("A" & NR, cs.Range("B" & cs.Rows.Count).End(xlUp).Offset(0, -1)) = ws.Name
Else
cs.Range("A" & NR).PasteSpecial xlPasteValuesAndNumberFormats
End If
NR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row + 1
End If
Next ws
'Sort
LR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row
On Error Resume Next
sCol = cs.Cells.Find(SortStr, after:=cs.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column
cs.Range("A1:BB" & LR).Sort Key1:=cs.Cells(2, sCol + (IIf(sName, 1, 0))), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Cleanup
If sName Then cs.[A1] = "Sheet"
cs.Rows(1).Font.Bold = True
cs.Cells.Columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True
cs.Activate
Range("A1").Select
Set cs = Nothing
End Sub
Example Sheet Origin Data this is not needed just for illustration | InvoiceNumber | InvoiceDate | PoNumber | VendorModelNumber | TSCSKUNumber | Description | Quantity | NumberOfCarton | UnitCost |
Sheet1 | N123456 | 4/26/2020 | 12345678 | 1xxxx | 1234567 | RET LODGE | 300 | 300 | $ 57.00 |
Sheet2 | N234567 | 4/20/2020 | 23456789 | 0510R | 7891011 | RET 5X10 ROOF | 280 | 280 | $ 35.00 |
Sheet2 | N234567 | 4/20/2020 | 23456789 | 1010SP | 2345678 | LODGE SOLID WIND GUARD | 370 | 370 | $ 22 |
Sheet2 | N234567 | 4/20/2020 | 23456789 | 21550N1 | 3456789 | FOLDING SADDLE RACK | 220 | 220 | $ 8.75 |
Sheet2 | N234567 | 4/20/2020 | 23456789 | L0608 | 4567890 | TARP 6FTX8FT | 860 | 43 | $ 1.00 |
Sheet1 | M12345 | 1/2/2020 | 34567890 | L0810 | 5678901 | TARP 7FTX9FT | 4046 | 289 | $ 2.70 |
Sub ConsolidateSheets()
'Merge all sheets in a workbook into one summary sheet (stacked)
'Data is sorted by a specific column name
Dim cs As Worksheet, ws As Worksheet
Dim LR As Long, NR As Long, sCol As Long
Dim sName As Boolean, SortStr As String
Application.ScreenUpdating = False
'From the headers in data sheets, enter the column title to sort by when finished
SortStr = "Statement Date"
'Add consolidation sheet if needed
'If Not Evaluate("ISREF(Consolidate!A1)") Then _
'Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Pivot EI YTD"
'Option to add sheet names to consolidation report
sName = MsgBox("Add sheet names to consolidation report?", vbYesNo + vbQuestion) = vbYes
'Setup
Set cs = ActiveWorkbook.Sheets("EI YTD")
cs.Cells.ClearContents
NR = 1
'Process each data sheet
For Each ws In Worksheets
If ws.Name <> cs.Name And _
ws.Name <> "Pivot EI YTD" Then
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
'customize this section to copy what you need
If NR = 1 Then
'copy titles and data to start the consolidation, edit row as needed for source of titles
ws.Range("A1", ws.Cells(1, Columns.Count).End(xlToLeft)).Copy
If sName Then
cs.Range("B1").PasteSpecial xlPasteAll
Else
cs.Range("A1").PasteSpecial xlPasteAll
End If
NR = 2
End If
ws.Range("A2:BB" & LR).Copy 'copy data, edit as needed for the start row
If sName Then 'paste and add sheet names if required
cs.Range("B" & NR).PasteSpecial xlPasteValuesAndNumberFormats
cs.Range("A" & NR, cs.Range("B" & cs.Rows.Count).End(xlUp).Offset(0, -1)) = ws.Name
Else
cs.Range("A" & NR).PasteSpecial xlPasteValuesAndNumberFormats
End If
NR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row + 1
End If
Next ws
'Sort
LR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row
On Error Resume Next
sCol = cs.Cells.Find(SortStr, after:=cs.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column
cs.Range("A1:BB" & LR).Sort Key1:=cs.Cells(2, sCol + (IIf(sName, 1, 0))), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Cleanup
If sName Then cs.[A1] = "Sheet"
cs.Rows(1).Font.Bold = True
cs.Cells.Columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True
cs.Activate
Range("A1").Select
Set cs = Nothing
End Sub