Run Macro on all sheets but one

[CPAgirl]

I need help getting a macro to work across all of my worksheets except one. Currently the macro checks the age of consumer files on sheet 10 (not sure why the number of the sheet is 10) to see if they are over 3 years old. It then copies those files over 3 years old onto Sheet 1, which is titled "Over 3 Years". However, sometimes I have more than one sheet of data....each sheet relating to a different bank account. How do I get the macro to run through all sheets of data except for Sheet 1? Here is my code:

Sub Over3Years()

Dim rng As Range
Dim cell As Range
Dim lr As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Sheet10
Set ws2 = Sheet1

lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws1.Range("F16:F" & lr)

For Each cell In rng
If cell.Value >= 3 Then
cell.Offset(0, -5).Resize(1, 4).Copy
If ws2.Range("A11").Value = "" Then
ws2.Range("A11").PasteSpecial xlPasteValues
Else
Cells((Cells(Rows.Count, 2).End(xlUp).Row) + 1, "A").PasteSpecial xlPasteValues
End If
End If
Next cell

End Sub

I tried adding this code:

dim ws as worksheet
for each ws in thisworkbook.worksheets
if ws.name <> "sheet name" then
'your code
end if
next ws

 

[CPAgirl]

I need help getting a macro to work across all of my worksheets except one. Currently the macro checks the age of consumer files on sheet 10 (not sure why the number of the sheet is 10) to see if they are over 3 years old. It then copies those files over 3 years old onto Sheet 1, which is titled "Over 3 Years". However, sometimes I have more than one sheet of data....each sheet relating to a different bank account. How do I get the macro to run through all sheets of data except for Sheet 1? Here is my code:

Sub Over3Years()

Dim rng As Range
Dim cell As Range
Dim lr As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Sheet10
Set ws2 = Sheet1

lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws1.Range("F16:F" & lr)

For Each cell In rng
If cell.Value >= 3 Then
cell.Offset(0, -5).Resize(1, 4).Copy
If ws2.Range("A11").Value = "" Then
ws2.Range("A11").PasteSpecial xlPasteValues
Else
Cells((Cells(Rows.Count, 2).End(xlUp).Row) + 1, "A").PasteSpecial xlPasteValues
End If
End If
Next cell

End Sub

I tried adding this code:

dim ws as worksheet
for each ws in thisworkbook.worksheets
if ws.name <> "sheet name" then
'your code
end if
next ws

Sorry this posted before I was done. Anyway, when I added that code it gives me an error message about the Next WS statement. I am sure that I have inserted it incorrectly.

Also, this code runs very slow. Is there anything in the code that is slowing it down? And it continues to run after the data has been retrieved. Any suggestions?



Thank in advance!!

 

[KenU]

Try the modified code below.

Sub Over3Years()

Dim rng As Range
Dim cell As Range
Dim lr As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rOut As Range

'Set ws1 = Sheet10
Set ws2 = ThisWorkbook.Worksheets("Over 3 Years")
lr = ws2.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Set rOut = ws2.Cells(lr, 1)

For Each ws1 In ThisWorkbook.Worksheets
    If ws.Name <> ws2.Name Then
        lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
        Set rng = ws1.Range("F16:F" & lr)
        
        For Each cell In rng
            If cell.Value >= 3 Then
                cell.Offset(0, -5).Resize(1, 4).Copy
                rOut.PasteSpecial xlPasteValues
                Set rOut = rOut.Cells(2, 1)
'                If ws2.Range("A11").Value = "" Then
'                    ws2.Range("A11").PasteSpecial xlPasteValues
'                Else
'                    Cells((Cells(Rows.Count, 2).End(xlUp).Row) + 1, "A").PasteSpecial xlPasteValues
'                End If
            End If
        Next cell
    End If
Next ws1

End Sub

Hope that helps!

Regards,
Ken

 

[KenU]

It appears that I had a mistake in the code above a "ws" that should be "ws1" as in the updated code below.

Sub Over3Years()

Dim rng As Range
Dim cell As Range
Dim lr As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rOut As Range

'Set ws1 = Sheet10
Set ws2 = ThisWorkbook.Worksheets("Over 3 Years")
lr = ws2.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
Set rOut = ws2.Cells(lr, 1)

For Each ws1 In ThisWorkbook.Worksheets
    If ws1.Name <> ws2.Name Then
        lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
        Set rng = ws1.Range("F16:F" & lr)
        
        For Each cell In rng
            If cell.Value >= 3 Then
                cell.Offset(0, -5).Resize(1, 4).Copy
                rOut.PasteSpecial xlPasteValues
                Set rOut = rOut.Cells(2, 1)
'                If ws2.Range("A11").Value = "" Then
'                    ws2.Range("A11").PasteSpecial xlPasteValues
'                Else
'                    Cells((Cells(Rows.Count, 2).End(xlUp).Row) + 1, "A").PasteSpecial xlPasteValues
'                End If
            End If
        Next cell
    End If
Next ws1

End Sub

Sorry for any confusion.

Regards,
Ken

 

[CPAgirl]

Yes, I was able to figure that out. Thank you so much for your help. I tweaked it a little bit and it works perfectly.

Thanks again!!!