Combine 2 Macros to Consolidate Data from Multiple Sheets and then Delete Blank Rows

Hello, this is my first time using a Macro and I am hoping to get some help to make it quicker/more efficient.

I have multiple sheets that i am combining data from (if the sheet is not the destination sheet, is visible and starts with WBS)... unfortunately the sheets are templates so i have formulas down to row 204 so the macro copies all of the cells with formulas, which are returning "". The macro copies/pastes values and formats and deletes conditional formatting.

Then.. I have another macro that goes through the new destination sheet and deletes all of the blank rows

Is there a way to combine these so it can all be done with one button?

Also, is there a way to get my column headers (only from the first sheet) -- i do not want to repeat column headers from each sheet, so for now i just skipped this - no column hearders on my data extract.


Private Sub CommandButton1_Click()

Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'We use the ActiveSheet but you can replace this with
'Sheets("MySheet")if you want
With Sheets("Pricing")

'We select the sheet so we can change the window view
.Select

'If you are in Page Break Preview Or Page Layout view go
'back to normal view, we do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

'Turn off Page Breaks, we do this for speed
.DisplayPageBreaks = False

'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1

'We check the values in the A column in this example
With .Cells(Lrow, "J")

If Not IsError(.Value) Then

If .Value = "" Then .EntireRow.Delete
'This will delete each row with the Value "ron"
'in Column A, case sensitive.

End If

End With

Next Lrow

End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub




Private Sub Consolidate_Click()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "Pricing" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Pricing").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "Pricing"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Pricing"

'Fill in the start row
StartRow = 25

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Worksheets

'Loop through all worksheets except the RDBMerge worksheet and the
'Information worksheet, you can ad more sheets to the array if you want.
If sh.Name <> DestSh.Name And sh.Visible = True And UCase(Left(sh.Name, 3)) = "WBS" Then

'Find the last row with data on the DestSh and sh
Last = Lastrow(DestSh)
shLast = Lastrow(sh)

'If sh is not empty and if the last row >= StartRow copy the CopyRng
If shLast > 0 And shLast >= StartRow Then

'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

'This example copies values/formats
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial 8 ' Column width
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If

End If
Next

Sheets("Pricing").Cells.FormatConditions.Delete

ExitTheSub:

Application.Goto DestSh.Cells(1)

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

Note: I start copying from row 25 because there is stuff above row 25 on each worksheet that should not be pulled into my data extract. Also, if there is a way to stop my extract at row R that would be great!!