Consolidating data ranges from multiple worksheets.

[BenjaminRowell]

Good morning!

So I have worksheets all structured in the same template (these are shipping packing lists.) I need VBA code to copy only the populated rows from each worksheet in my template. the data I need begins from row 11 (the other rows above this contain delivery information unimportant in the end result of the consolidated packing list) (worksheet quantities vary from week to week.) The code ideally needs to only copy the entire row if collumn W11:390 contains text/numbers and paste in order of worksheets, onto a consolidated template. sometimes one individual packing list can have multiple pallets and thus a space is put inbetween the product codes. worksheets including the final consolidated document all use the same template.

I've been trying to work on this for weeks now and im ripping my hair out. Image attached, not of my hair, the spreadsheet

 

[DThib]

Hi,
do you have any code you have written yet?

DThib

 

[BenjaminRowell]

This is becoming somewhat of a Frankenstein VBA code, This code works in consolidating all worksheets in their entirety to one new consolidated worksheet. the problem with this is it takes the entire sheets, I need only the rows between 11:398 IF W11:W398 contains text/numbers (unspecific on what it contains, only if it is populated.) any assistance is greatly appreciated


Sub ConsolidateAllPackinglists()
On Error GoTo IfError

Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range


' And Disable Events to avoid inturupted dialogs / popups
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True

With ActiveWorkbook
Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
DstSht.Name = "Consolidate_Data"
End With

For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> DstSht.Name Then
'5.1: Find the last row on the 'Consolidate_Data' sheet
DstRow = fn_LastRow(DstSht) + 1
'5.2: Find Input data range
LstRow = fn_LastRow(Sht)
LstCol = fn_LastColumn(Sht)
EnRange = Sht.Cells(LstRow, LstCol).Address
Set SrcRng = Sht.Range("A1:" & EnRange)

If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
GoTo IfError
End If

SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)
End If
Next
IfError:

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Function fn_LastRow(ByVal Sht As Worksheet)
Dim lastRow As Long
lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
lRow = Sht.Cells.SpecialCells(xlLastCell).Row
Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
lRow = lRow - 1
Loop
fn_LastRow = lRow
End Function

Function fn_LastColumn(ByVal Sht As Worksheet)
Dim lastCol As Long
lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
lCol = Sht.Cells.SpecialCells(xlLastCell).Column
Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
lCol = lCol - 1
Loop
fn_LastColumn = lCol
End Function