Joining two codes into one

Hi,

I've got a code that compiles several sheets into one combined sheet. However, I want to add to my code some adjustments to be made for the newly created combined sheet. The code to compile the data is this:

Sub Test()
    Dim SH As Worksheet
    Dim J As Integer
    Application.ScreenUpdating = False
        For Each SH In ThisWorkbook.Sheets
            SH.Rows("1:3").EntireRow.Delete
            SH.Columns("A:B").EntireColumn.Delete
            SH.Columns("E:E").EntireColumn.Delete
            SH.Cells.UnMerge
        Next
        
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Combined"

    ' copy headings
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    ' work through sheets
    For J = 2 To Sheets.Count ' from sheet 2 to last sheet
        Sheets(J).Activate ' make the sheet active
        Range("A1").Select
        Selection.CurrentRegion.Select ' select all cells in this sheets

        ' select all lines except title
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

        ' copy cells selected in the new sheet on last line
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next
   
End Sub

And the code I've recorded that I want done to the newly created combined sheet is this:

Sub Macro2()
'
' Macro2 Macro
'

'
    Columns("A:D").Select
    Columns("A:D").EntireColumn.AutoFit
    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
End Sub

Is there a way I can combine these macros into one so that it does both at the same time in the proper sequence? Thanks!

Parth.

I'm not sure if just calling Macro2 will do the trick as I'm not certain if he finishing on the new "Combined Sheet"

Another approach is to place this at the end of your Test Macro.

Note, you also do not need to 'select' something to do something with it.

With Worksheets("Combined")
    Columns("A:D").EntireColumn.AutoFit
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Selection.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
End With

Thanks for the replies. Unfortunately I haven't had any sucess yet with either approaches. To clarify the order, my first code trims all of my data sheets, copies just the data, creates a new sheet called "Combined" and then pastes all the data into the combined sheet. I've had sucess with the first code, but I am now trying to join the second code into this same code with the adjustments that I would like to see done to the "Combined" sheet after it has just been created. Basically the adjustments, which you all seem to understand, to the combined sheet are to find blanks within Column B, delete the entire row with blanks found in B, and to also copy the data name down throughout column A, changing as a new name appears. Any further suggestions to combine these codes? Let me know if you need an attachment, because I would have to attempt to remove a bunch of confidential information beforehand. Thanks again!

Try this

Sub Test()
    Dim SH As Worksheet
    Dim J As Integer
    Application.ScreenUpdating = False
        For Each SH In ThisWorkbook.Sheets
            SH.Rows("1:3").EntireRow.Delete
            SH.Columns("A:B").EntireColumn.Delete
            SH.Columns("E:E").EntireColumn.Delete
            SH.Cells.UnMerge
        Next
        
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Combined"

    ' copy headings
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    ' work through sheets
    For J = 2 To Sheets.Count ' from sheet 2 to last sheet
        Sheets(J).Activate ' make the sheet active
        Range("A1").Select
        Selection.CurrentRegion.Select ' select all cells in this sheets

        ' select all lines except title
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

        ' copy cells selected in the new sheet on last line
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next
   
   With Worksheets("Combined")
        .Columns("A:D").EntireColumn.AutoFit
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    End With
End Sub

Its almost there, the only changes that were made to the"Combined" sheet is that the columns A:D were Auto Fit for width, eveyrthing else stayed the same. Selecting blanks in column B and then deleting the entire rows with the blanks was not done, and copying the data name down in Column A was also not done. Thanks!

Sorry about that.

Replace the bottom half with this

 With Worksheets("Combined")
        .Columns("A:D").EntireColumn.AutoFit
        .Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Columns("A:A").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    End With

Thanks, that did the trick! Quick question: Now that I'm looking at my data, is there a way I could add into the code a step that Filters column B to show any Numbers or Blank cells? I'd like to delete all those values as well, but I'm not sure if this can be done through code. Thanks again to Ptmuldoon and others for the replies.