Using VBA to copy the values from a filtered range of variable length

[weasel21]

[FONT=&quot]I have the below macro created. It cycles through all sheets in a workbook, except for X, Y, and Z. For each sheet it takes the value in cell A1, and filters sheet ABC based on that value. Then it selects the displayed values from columns A through S on sheet ABC, down as far as row 100, and copies it into the current sheet. then it moves on to the next.[/FONT]
[FONT=&quot]It works when there is a definite range specified, e.g. A2:S1000. However, the range in the sheet will vary up to maybe 50,000 rows, but i don't want to set a hard cap on it. Also, setting a limit of 50,000 makes the file huge when the macro is run and the file is saved. I am hoping someone can help me find a function which will return the last active row, so that the range is A2 to S(last active row).[/FONT]
[FONT=&quot]Any help appreciated![/FONT]
[FONT=&quot]
[/FONT]
[FONT=&quot]

Sub FilterAndPaste()[/FONT]

[FONT=&quot]Dim CCS As Worksheet[/FONT]
[FONT=&quot]For Each CCS In Worksheets[/FONT]
[FONT=&quot]Select Case CCS.Name[/FONT]
[FONT=&quot]Case "X", "Y", "Z"[/FONT]
[FONT=&quot]Case Else[/FONT]
[FONT=&quot]CCS.Select[/FONT]
[FONT=&quot]With Worksheets("ABC")[/FONT]
[FONT=&quot].AutoFilterMode = False[/FONT]
[FONT=&quot]With .Range("A1:AC1")[/FONT]
[FONT=&quot].AutoFilter[/FONT]
[FONT=&quot].AutoFilter Field:=24, Criteria1:=Range("A1").Value[/FONT]
[FONT=&quot]Worksheets("ABC").Range("A2:S1000").SpecialCells(xlCellTypeVisible).Copy _[/FONT]
[FONT=&quot]Destination:=CCS.Range("A17")[/FONT]
[FONT=&quot]End With[/FONT]
[FONT=&quot]End With[/FONT]
[FONT=&quot]End Select[/FONT]
[FONT=&quot]Next CCS[/FONT]
[FONT=&quot]End Sub 

[/FONT]

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Worksheets("ABC").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim CCS As Worksheet
    For Each CCS In Worksheets
        Select Case CCS.Name
            Case "X", "Y", "Z"
            Case Else
                With Worksheets("ABC")
                    .AutoFilterMode = False
                    With .Range("A1:AC1")
                        .AutoFilter
                        .AutoFilter Field:=24, Criteria1:=Range("A1").Value
                        Worksheets("ABC").Range("A2:S" & LastRow).SpecialCells(xlCellTypeVisible).Copy CCS.Range("A17")
                    End With
                End With
        End Select
    Next CCS
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Another option

   Dim CCS As Worksheet
   For Each CCS In Worksheets
      Select Case CCS.name
      Case "X", "Y", "Z"
      Case Else
         With Worksheets("ABC")
            If .AutoFilterMode Then .AutoFilterMode = False
            .Range("A1:AC1").AutoFilter Field:=24, Criteria1:=CCS.Range("A1").Value
            .AutoFilter.Range.Offset(1).Copy CCS.Range("A17")
         End With
      End Select
   Next CCS

 

[weasel21]

Thats sorted! Thanks!

 

[Fluff]

Glad we could help & thanks for the feedback