VBA To consolidate Worksheets

gittymoe

Board Regular
Joined
Apr 23, 2005
Messages
79
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.

Example Sheet Origin Data this is not needed just for illustrationInvoiceNumberInvoiceDatePoNumberVendorModelNumberTSCSKUNumberDescriptionQuantityNumberOfCartonUnitCost
Sheet1N1234564/26/2020123456781xxxx
1234567​
RET LODGE 300300 $ 57.00
Sheet2N2345674/20/2020234567890510R
7891011​
RET 5X10 ROOF 280280 $ 35.00
Sheet2N2345674/20/2020234567891010SP
2345678​
LODGE SOLID WIND GUARD370370 $ 22
Sheet2N2345674/20/20202345678921550N1
3456789​
FOLDING SADDLE RACK220220 $ 8.75
Sheet2N2345674/20/202023456789L0608
4567890​
TARP 6FTX8FT86043 $ 1.00
Sheet1M123451/2/202034567890L0810
5678901​
TARP 7FTX9FT 4046289 $ 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
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

Watch MrExcel Video

Forum statistics

Threads
1,129,674
Messages
5,637,729
Members
416,981
Latest member
PLonchar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top