Copying Rows from sheet to sheet in Excel VBA based upon column values

Question

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim wks As Worksheet
On Error GoTo Err_Execute


For Each wks In Worksheets
    ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
    Set wksCopyTo = ActiveSheet
    wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3)

    'Start search in row 4
    LSearchRow = 4
    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 4

    While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0
        'If value in column E = "Mail Box", copy entire row to Sheet2
        If wks.Range("AB" & CStr(LSearchRow)).Value = "Yes" And wks.Range("AK" & CStr(LSearchRow)).Value = "Yes" And wks.Range("BB" & CStr(LSearchRow)).Value = "Y" Then
            'Select row in Sheet1 to copy
            wks.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            MsgBox "Copying Row"
            'Paste row into Sheet2 in next row
            wksCopyTo.Select
            wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            wksCopyTo.Paste
            MsgBox "Pasting Row"
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            'Go back to Sheet1 to continue searching
            wks.Select
        End If
        LSearchRow = LSearchRow + 1
    Wend

    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select
    MsgBox "All matching data has been copied."
Next wks

Exit Sub
Err_Execute:
    MsgBox "An error occurred."

Hi

I have the above code which based upon from code given elsewhere. The code has been adapted where I need it to do to create a new worksheet for each existing worksheet when copying those rows that meet the criteria given in the if statement. The problem I have are:

Does excel allow you to find out first all the worksheets that exist before running the code so you don't go round in a loop?
The code I have given whilst working on one worksheet, will not execute after the while, and I cannot see why?
When I have run it on the one worksheet it crashes after 32,000 rows

Can anyone help?

markblandford markblandford · Accepted Answer · 2012-05-11T14:55:54

I'll answer your questions one by one:

Yes. You can use something like ThisWorkbook.Worksheets.Count to return the number of worksheets the current workbook has. The best way to loop through worksheets however is to itterate through the Worksheets Collection:
```
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
    'Do something
    '...
Next wks

Set wks = Nothing
```
You are never exiting the loop (if you have >32,000 rows of data in Column A), until of course you get an Overflow error (Integers can only go to 32,767 +/-).
See point 2. You are looping beyond the limits of an Integer. Either change the data type to a Long and/or, as stated in point 2, exit your loop at some point.

Copying Rows from sheet to sheet in Excel VBA based upon column values

1 Answers