I am pulling my hair out

[James8309]

Hi Everyone

I have this code that filters 'non-empty cells' in 4 different sheets
from A3 to last row then paste into sheet5. I think majority of code
is doing what it is suppose to be doing except last one inside of my
For ~ Next statement.

As you can see Sheet1,2,3 and 4 gets filtered and results gets pasted
into sheet5. It is suppose to paste the result then find the lastrow +
1 then paste and so on but It seems it is not doing that.

Can anyone help?

Thank you!

Regards

James


Here is the part of the code

Application.ScreenUpdating = False
LastRange = Sheets("Sheet5").Range("A65000").End(xlUp).Row + 1


shArray = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
With Sheets("Sheet5")
Set CopyToRange = .Range("A" & LastRange)
End With

For sh = 0 To UBound(shArray)
Sheets(shArray(sh)).Activate
LRR = Range("A3").End(xlDown).Row
Set FilterRange = Range("A3", Cells(LRR, "C"))
FilterRange.AutoFilter field:=2, Criteria1:="<>"
FilterRange.Copy Destination:=CopyToRange
FilterRange.AutoFilter
' Problem seems to start
here!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
With Sheets("Sheet5")
Set CopyToRange = .Range("A3").End(xlDown)
End With
Next
Application.ScreenUpdating = True

 

[Bob Phillips]

Not tested, but maybe

Application.ScreenUpdating = False

shArray = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")

For sh = 0 To UBound(shArray)

With Sheets("Sheet5")

LastRange = .Cells(.Rows.Count, "A6").End(xlUp).Row + 1
Set CopyToRange = .Range("A" & LastRange)
End With

With shArray(sh)

LRR = .Range("A3").End(xlDown).Row
Set FilterRange = .Range("A3", .Cells(LRR, "C"))
FilterRange.AutoFilter field:=2, Criteria1:="<>"
FilterRange.SpecialCells(xlCellTypeVisible).Copy
Destination:=CopyToRange
FilterRange.AutoFilter
End With
Next

Application.ScreenUpdating = True

 

[James8309]

Not tested, but maybe

    Application.ScreenUpdating = False

    shArray = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")

    For sh = 0 To UBound(shArray)

        With Sheets("Sheet5")

            LastRange = .Cells(.Rows.Count, "A6").End(xlUp)..Row + 1
            Set CopyToRange = .Range("A" & LastRange)
        End With

        With shArray(sh)

            LRR = .Range("A3").End(xlDown).Row
            Set FilterRange = .Range("A3", .Cells(LRR, "C"))
            FilterRange.AutoFilter field:=2, Criteria1:="<>"
            FilterRange.SpecialCells(xlCellTypeVisible).Copy
Destination:=CopyToRange
            FilterRange.AutoFilter
        End With
    Next

    Application.ScreenUpdating = True

--
__________________________________
HTH

Bob













- Show quoted text -

I am getting object defined error everywhere (T_T)

 

[Bob Phillips]

Everywhere? For example?

--
__________________________________
HTH

Bob

Not tested, but maybe

Application.ScreenUpdating = False

shArray = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")

For sh = 0 To UBound(shArray)

With Sheets("Sheet5")

LastRange = .Cells(.Rows.Count, "A6").End(xlUp).Row + 1
Set CopyToRange = .Range("A" & LastRange)
End With

With shArray(sh)

LRR = .Range("A3").End(xlDown).Row
Set FilterRange = .Range("A3", .Cells(LRR, "C"))
FilterRange.AutoFilter field:=2, Criteria1:="<>"
FilterRange.SpecialCells(xlCellTypeVisible).Copy
Destination:=CopyToRange
FilterRange.AutoFilter
End With
Next

Application.ScreenUpdating = True

--
__________________________________
HTH

Bob













- Show quoted text -

I am getting object defined error everywhere (T_T)