Format worksheets 5 and on, then copy&paste that info into "Sheet3" with source width and format

Question

I am currently try to make a code that will format sheets 5 and on to module one's code and then have the program copy all the information in each of those newly formatted sheets and paste them into "sheet3" with original width and format.

I have tried the "for each" and "integer" functions but can't seem to get 'the program to move past "sheet5".

This sub is suppose to go through all of the sheets and and 'format them to my needs:

Sub TEST2()
    Dim ws As Worksheet
    Dim wsDest As Worksheet
    Dim LastRow As Long

    Set wsDest = Sheets("sheet3")
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name <> wsDest.Name And _
           ws.Name <> "sheet1" And _
           ws.Name <> "sheet2" And _
           ws.Name <> "sheet4" Then
            'code here
            Columns.Range("A:A,B:B,H:H,I:I").Delete
            Columns("A").ColumnWidth = 12
            Columns("B").ColumnWidth = 17
            Columns("C").ColumnWidth = 10
            Columns("D").ColumnWidth = 85
            Columns("E").ColumnWidth = 17
            ActiveSheet.Range("D:D").WrapText = True
            ActiveSheet.Range("F:F").EntireColumn.Insert
            ActiveSheet.Range("F1").Formula = "Product ID"
            LastRow = Cells(Rows.Count, 1).End(xlUp).Row
            Range("F2:F" & LastRow).Formula = "=$G$2"
            ActiveSheet.Range("F2").Copy
            Range("F2:F" & LastRow).PasteSpecial Paste:=xlPasteValues
        End If
    Next ws
End Sub

This sub is meant to go to "sheet5" first and paste it into '"sheet3", than the second half of the sub should start at "sheet6" and go on 'until the end of the work sheets and then copy & paste onto "sheet3" with 'original width.

Sub Test1()
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim WS_Count As Integer
    Dim I As Integer

    Sheets("Sheet5").Select
    Application.CutCopyMode = False
    Application.Run "PERSONAL.XLSB!Module1.Del_move_insert_colmuns"
    Range("G2").Select
    ActiveCell.Offset(0, -1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("A1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                           SkipBlanks:=False, Transpose:=False
    ActiveSheet.Range("D:D").WrapText = True

    WS_Count = ActiveWorkbook.Worksheets.Count
    ' Begin the loop
    For I = 5 To WS_Count
        'code here
        Sheets("Sheet6").Select
        Application.Run "PERSONAL.XLSB!Module1.Del_move_insert_colmuns"
        Application.CutCopyMode = False
        Range("G2").Select
        ActiveCell.Offset(0, -1).Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToLeft)).SelectApplication.CutCopyMode = False
        Selection.Copy
        Sheets("Sheet3").Select
        Range("A1").Select
        'crtl shift + down
        Selection.End(xlDown).Select
        'moves down one cell to paste
        ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                               SkipBlanks:=False, Transpose:=False

    Next I

End Sub

What im getting right now is it does "sheet5" and "sheet6" fine,but after that doesn't format and on sheet there all i get is a bunch of columns with top labeled as product ID and a bunch of 0's.

Answer 1

A big part of your problem is that most of your code is "assuming" that you are working with a certain worksheet when you're really working with the ActiveSheet. As an example in your TEST2 routine, you're looping through all of the worksheets in the workbook, skipping certain sheets. This part works fine. But when you want to format the other sheets, you're really only working with whatever worksheet is currently active. To fix this, you should make a habit of making sure all of your Worksheet, Range, and Cells reference are always fully qualified. So then your code works like this:

ws.Columns.Range("A:A,B:B,H:H,I:I").Delete
ws.Columns("A").ColumnWidth = 12
ws.Columns("B").ColumnWidth = 17
ws.Columns("C").ColumnWidth = 10
ws.Columns("D").ColumnWidth = 85
ws.Columns("E").ColumnWidth = 17
ws.Range("D:D").WrapText = True
ws.Range("F:F").EntireColumn.Insert
ws.Range("F1").Formula = "Product ID"
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
ws.Range("F2:F" & LastRow).Formula = "=$G$2"
ws.Range("F2").Copy
ws.Range("F2:F" & LastRow).PasteSpecial Paste:=xlPasteValues

Notice how every single reference is locked to the same worksheet. You can take a shortcut though, by using the With statement. But you must make sure that each reference has the . in front of it to lock it back to the With object, like this:

With ws
    .Columns.Range("A:A,B:B,H:H,I:I").Delete
    .Columns("A").ColumnWidth = 12
    .Columns("B").ColumnWidth = 17
    .Columns("C").ColumnWidth = 10
    .Columns("D").ColumnWidth = 85
    .Columns("E").ColumnWidth = 17
    .Range("D:D").WrapText = True
    .Range("F:F").EntireColumn.Insert
    .Range("F1").Formula = "Product ID"
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("F2:F" & LastRow).Formula = "=$G$2"
    .Range("F2").Copy
    .Range("F2:F" & LastRow).PasteSpecial Paste:=xlPasteValues
End With

For the rest of your code, you can make improvements by avoiding the use of Select and Activate. Consider also the tips discussed in this article that will give you excellent guidance.