Loop Through Each Worksheet in ThisWorkbook

[thardin]

Ok, I have this very complex code that works most of the time for a daily report, but isn't completely dependable.
This Macro is trying to copy columns B and L for every worksheet into 1 worksheet in a new Workbook(in columns A and B).
The problem is, sometimes all 3 worksheets are present and sometimes only 1 or 2, sometimes the worksheet names change, and sometimes come in blank, which sometimes breaks the code.
To prevent this, I think I want to use a "For Each Worksheet in ThisWorkbook" statement.
How do you recommend achieving this?

Thanks.

Function WorksheetExists(SheetName As String, lr As Long) As Boolean
    Dim ws As Worksheet
    WorksheetExists = False
  
    
        For Each ws In Worksheets
            If ws.Name = SheetName Then
                WorksheetExists = True
                Exit For
            End If
        Next
End Function

Sub UBTCopy_Copy_Columns_B_And_L_to_New_WS()
'
' UBTCopy_And_Paste Macro
'
'
    Dim ws1 As String, ws2 As String, ws3 As String

 
    Dim S As String
    Dim Ary As Variant
    Dim fname As String, DestinationFileName As String
    Dim SourceFileName As String
    

 
    SourceFileName = ejFullDate & " EdJones A Share Restrictions Voids " & My_Initials & " " & ejFullDate4 & ".xlsx"
    DestinationFileName = "529UBTREJ" & ejFullDate2 & ".xlsx"

        
    Workbooks(SourceFileName).Activate

    ws1 = UBT_WS1
    ws2 = UBT_WS2
    ws3 = UBT_WS3

    
    '   Find last row in column U with data
    lr = Cells(Rows.Count, "U").End(xlUp).Row
        
    
    If WorksheetExists(ws1) Then
        '   Copy data
        lr = Cells(Rows.Count, "U").End(xlUp).Row
        If lr > 3 Then
            ws1Row_Start = 2
            ws1Row_Count = Worksheets(ws1).Cells(Rows.Count, "U").End(xlUp).Row - 3
            With Worksheets(ws1).UsedRange
                Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
            'Pastes data in destination file in cell A2 Data:
            End With
              
    
            With Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws1Row_Start).Resize(UBound(Ary), 2)
            .NumberFormat = "@"
            .Value = Ary
            ActiveSheet.UsedRange.EntireColumn.AutoFit
            ActiveSheet.UsedRange.EntireRow.AutoFit
            End With
        Else
            ws1Row_Start = 2
            ws1Row_Count = 0
        End If
    Else
            ws1Row_Start = 2
            ws1Row_Count = 0
    End If
        
    
    If WorksheetExists(ws2) Then
        '   Copy data
            ws2Row_Start = ws1Row_Start + ws1Row_Count
                
    ws2Row_Count = Worksheets(ws2).Cells(Rows.Count, "U").End(xlUp).Row - 3
        With Worksheets(ws2).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
        End With
       'Pastes data in destination file under WS1 Data:
      With Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws2Row_Start).Resize(UBound(Ary), 2)
        .NumberFormat = "@"
        .Value = Ary
        ActiveSheet.UsedRange.EntireColumn.AutoFit
        ActiveSheet.UsedRange.EntireRow.AutoFit
    
        
      End With
     End If

    If WorksheetExists(ws3) Then
     '   Copy data
        ws3Row_Count = Worksheets(ws3).Cells(Rows.Count, "U").End(xlUp).Row - 3
            ws3Row_Start = ws2Row_Start + ws2Row_Count
        With Worksheets(ws3).UsedRange
            Ary = Application.Index(.Value, .Worksheet.Evaluate("row(4:" & .Rows.Count & ")"), Array(2, 12))
        End With
        'pastes data in destination file under the WS1 and WS2 data:
        With Workbooks(DestinationFileName).ActiveSheet.Range("A" & ws3Row_Start).Resize(UBound(Ary), 2)
        .NumberFormat = "@"
        .Value = Ary
        ActiveSheet.UsedRange.EntireColumn.AutoFit
        ActiveSheet.UsedRange.EntireRow.AutoFit
    
        End With
    End If
    
    Workbooks(DestinationFileName).Activate
        lr = Cells(Rows.Count, "A").End(xlUp).Row
        Range("A2:A" & lr).Copy
  
    'Saving Account Numbers to Notepad on Desktop:
    Workbooks.Add
    '
    Range("A1").PasteSpecial Paste:=xlPasteValues
    '
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs FileName:=My_Desktop & "Notepad.txt", FileFormat:=xlText
    ActiveWorkbook.SaveAs FileName:=TEMPLATES_FOLDER & "Notepad.txt", FileFormat:=xlText
    
    Application.DisplayAlerts = True
        
    ActiveWorkbook.Close False
    With ActiveWindow
        .WindowState = xlNormal
        .Width = 400
        .Height = 591.75
        .Left = 1000
        .Top = 0
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True


End Sub

 

[thardin]

I get a Runtime error 438: "Object doesn't support this property or method."

BTW, I know how to set up a for loop, so that's not exactly what I need help with.
What I need help with is the code to put INSIDE the for loop for the task I mentioned.


This is the code I used to test your method:

Sub test()

Dim srcWB As Workbook
Dim desWB As Workbook
Dim ws As Worksheet

Set srcWB = ThisWorkbook


For Each ws In srcWB
lr = Cells(Rows.Count, "A").End(xlUp).Row
MsgBox SheetName & lr
Next ws

End Sub

Also, When I click on "debug" in the locals window it says the variable ws is "nothing".
I tried commenting the Msgbox line to see if that was it, but it still didn't work.

Also, to be more specific on the task I'm trying to complete,
Everyday I receive a workbook that has between 1 and 3 worksheets. Usually the ws names are the same but sometimes change.
Each worksheet has 3 rows of headers and some data in red and some in black.
What I'm trying to do in this macro, is copy the columns B and L ONLY FOR THE RED DATA for every ws from the srcWB to a desWB.

Just a note: Right now I have a macro done in a previous step that does a calculation in column U for only red data, so that's why my lr is based off of column U.

Thank you.

 

[Joe4]

There are a few issues with your code here:

Sub test()

Dim srcWB As Workbook
Dim desWB As Workbook
Dim ws As Worksheet

Set srcWB = ThisWorkbook


For Each ws In srcWB
lr = Cells(Rows.Count, "A").End(xlUp).Row
MsgBox SheetName & lr
Next ws

End Sub

Firstly, you did NOT preface the range with the sheet reference here:

lr = Cells(Rows.Count, "A").End(xlUp).Row

As you loop through all the sheets, you are NOT returning the the last row of each, you are finding the last row of whatever the active sheet is repeatedly, as looping through each sheet does not actually activate/select that sheet.

So you want to include the sheet reference in this calculation to tell VBA what sheet exactly you are trying to find the last row of, i.e.

lr = ws.Cells(Rows.Count, "A").End(xlUp).Row

And then in your MsgBox, "SheetName" is NOT a valid value.
If you want to return the name of the sheet, you should use:

ws.Name

So try this code:

Sub test()

Dim srcWB As Workbook
Dim desWB As Workbook
Dim ws As Worksheet

Set srcWB = ThisWorkbook


For Each ws In srcWB
    lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
    MsgBox ws.Name & ":" & lr
Next ws

End Sub

 

[thardin]

I

There are a few issues with your code here:

Sub test()

Dim srcWB As Workbook
Dim desWB As Workbook
Dim ws As Worksheet

Set srcWB = ThisWorkbook


For Each ws In srcWB
lr = Cells(Rows.Count, "A").End(xlUp).Row
MsgBox SheetName & lr
Next ws

End Sub

Firstly, you did NOT preface the range with the sheet reference here:

lr = Cells(Rows.Count, "A").End(xlUp).Row

As you loop through all the sheets, you are NOT returning the the last row of each, you are finding the last row of whatever the active sheet is repeatedly, as looping through each sheet does not actually activate/select that sheet.

So you want to include the sheet reference in this calculation to tell VBA what sheet exactly you are trying to find the last row of, i.e.

lr = ws.Cells(Rows.Count, "A").End(xlUp).Row

And then in your MsgBox, "SheetName" is NOT a valid value.
If you want to return the name of the sheet, you should use:

ws.Name

So try this code:

Sub test()

Dim srcWB As Workbook
Dim desWB As Workbook
Dim ws As Worksheet

Set srcWB = ThisWorkbook


For Each ws In srcWB
    lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
    MsgBox ws.Name & ":" & lr
Next ws

End Sub

I get the same runtime error

 

[Joe4]

OK, forgot a key word. Sorry about that.

Try this:

Sub test()

Dim srcWB As Workbook
Dim desWB As Workbook
Dim ws As Worksheet
Dim lr As Long

Set srcWB = ActiveWorkbook


For Each ws In srcWB.Worksheets
    lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
    MsgBox ws.Name & ":" & lr
Next ws

End Sub

 

[thardin]

T

OK, forgot a key word. Sorry about that.

Try this:

Sub test()

Dim srcWB As Workbook
Dim desWB As Workbook
Dim ws As Worksheet
Dim lr As Long

Set srcWB = ActiveWorkbook


For Each ws In srcWB.Worksheets
    lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
    MsgBox ws.Name & ":" & lr
Next ws

End Sub

That code works now for the test.

 

[thardin]

T

That code works now for the test.

But now, how do you recommend copying ONLY the red data(like in the picture) from columns 2 and 12 from each worksheet into 1 worksheet of another saved workbook(in columns 1 and 2) using this for loop?

 

[Joe4]

But now, how do you recommend copying ONLY the red data(like in the picture) from columns 2 and 12 from each worksheet into 1 worksheet of another saved workbook(in columns 1 and 2) using this for loop?

Copying just the red data was not part of the initial question posted. That is a different question/matter altogether.
As such, I would recommend starting a new thread on that question.

 

[thardin]

Copying just the red data was not part of the initial question posted. That is a different question/matter altogether.
As such, I would recommend starting a new thread on that question.

My initial question was how to perform an equivalent task of my existing code without having to use worksheet names!

 

[thardin]

My initial question was how to perform an equivalent task of my existing code without having to use worksheet names!

and I haven't seen code for that yet.

it includes more than just the "for loop" code because how do I specify where the data is to be pasted on the destination worksheet.

 

[Joe4]

This was your original question:

To prevent this, I think I want to use a "For Each Worksheet in ThisWorkbook" statement.
How do you recommend achieving this?

Your initial question code did not include anything about "red coding", nor did you include any images to show what you were working with.
So it looked to me that your initial questions was how to do the loop, which is what I was answering.

If you have some new aspect of your code you wish to ask about, it is to your advantage to ask it in a new thread. That way, it will appear as a new unanswered question, and will show up on the "Unanswered threads" listing that many people use to look for new unanswered questions, and it will get many more eyes seeing it.