着色过滤结果并复制，减去标题答案

【问题标题】：Colouring Filtered Results and copying over, minus the header着色过滤结果并复制，减去标题
【发布时间】：2020-11-16 13:30:25
【问题描述】：

我正在尝试按月和发票过滤我的数据，然后为结果着色并将它们复制到数据底部的单独选项卡中，这一切正常，但它似乎为我的数据下方的每一行着色以进行复制慢了很多，而且它似乎也复制了标题，有没有办法只用数据为行着色而不复制标题？

   Sub FILTERING()

    strInput = InputBox("Please Enter the Month you are Analysing in the following format: Jan-20 (No Spaces)")
    ActiveSheet.Range("Y1:Y1").AutoFilter Field:=25, Criteria1:=strInput

     ActiveSheet.Range("A:AK").AutoFilter Field:=29, Criteria1:= _
        "=INVOICED"
        Purpley = RGB(228, 223, 236)
    Range("A:AK").SpecialCells(xlCellTypeVisible).Interior.Color = Purpley

    Dim lastRow As Long
    With Sheets("Data")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    Range("A:AK").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy 
    Destination:=Sheets("Data").Cells(lastRow, "A")

    End Sub

【问题讨论】：

标签： excel vba filtering

【解决方案1】：

请尝试下一个代码：

Sub FILTERING()
  Dim sh As Worksheet, lastR As Long, strInput As String
  
  Set sh = ActiveSheet
    lastR = sh.Range("A" & Rows.count).End(xlUp).Row
      
    strInput = InputBox("Please Enter the Month you are Analysing in the following format: Jan-20 (No Spaces)")
    ActiveSheet.Range("Y1:Y1").AutoFilter field:=25, Criteria1:=strInput

     ActiveSheet.Range("A:AK").AutoFilter field:=29, Criteria1:= _
        "=INVOICED"
        Purpley = RGB(228, 223, 236)
    Range("A2:AK" & lastR).SpecialCells(xlCellTypeVisible).Interior.Color = Purpley

    Dim lastRow As Long
    With Sheets("Data")
        lastRow = .cells(.Rows.count, "A").End(xlUp).Row + 1
    End With
    Range("A1:AK" & lastR).Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy _
                       Destination:=Sheets("Data").cells(lastRow, "A")
    End Sub

【讨论】：