Excel VBA - 自动筛选后从 B 列开始复制数据

Question

我正在尝试使用自动过滤器过滤工作表中的数据并将结果复制到另一个工作表。 到目前为止这有效，但我需要从 B 列开始的数据。到目前为止我还没有找到解决方案。 希望可以有人帮帮我：）

    Dim myRange As Range

lZeile = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
MsgBox lZeile



ActiveSheet.Rows("7:7").AutoFilter Field:=12, Criteria1:="x"

On Error Resume Next
Set myRange = Range(Cells(8, 1), Cells(lZeile, 19)).SpecialCells(xlVisible)
On Error GoTo 0

If myRange Is Nothing Then
    MsgBox "no cells"
Else
    Intersect(Sheets("Sheet1").UsedRange, Sheets("Sheet1").UsedRange.Offset(7)).SpecialCells(xlCellTypeVisible).Copy
       
    Worksheets("Sheet2").Activate
    Worksheets("Sheet2").Cells(1, 1).PasteSpecial xlPasteValues
End If

Answer 1

以下代码应为您提供所需的结果 - 基于表 1 第 7 行中要复制的数据的标题。让我知道它是如何进行的。

Option Explicit
Sub CopyFilterX()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim CheckRow As Long

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

With ws1.Cells(7, 1).CurrentRegion
    .AutoFilter 12, "x"
    CheckRow = ws1.Cells(Rows.Count, 2).End(xlUp).Row
        If CheckRow = 7 Then
            MsgBox "no cells"
            .AutoFilter
            Exit Sub
        End If
    .Offset(1, 1).Copy ws2.Cells(1, 1)
    .AutoFilter
End With

End Sub

Answer 2

替换这一行：

Set myRange = Range(Cells(8, 1), Cells(lZeile, 19)).SpecialCells(xlVisible)

有了这个：

Set myRange = Range(Cells(8, 2), Cells(lZeile, 19)).SpecialCells(xlVisible)