Excel VBA根据相邻单元格将单元格从一个工作表复制到另一个工作表

Question

我在上一个帖子中询问如何根据单元格值将单元格从一个工作表复制到另一个工作表（例如，如果单元格 A3 有一个“x”，则将单元格 B3 中的值复制到工作表“work”）。

我成功编写了一些 VBA 代码来执行该任务，但它最终会变得非常长（我有 30 个工作表要扫描）。

这是有效的（现在它被设置为只做 2 个工作表）

Private Sub Load_Order_Click()
' Setup Data
    Dim Last_Row0 As Long
    Dim ws0 As Worksheet
    Set ws0 = Sheets("work")

' Sort and Copy Data from each page to Work
' Sheet 1
With Sheets("1 - Conduit")
    .Range("A:B").AutoFilter Field:=1, Criteria1:="x"
    .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy
    End With
With Sheets("work")
    .Range("A1").PasteSpecial xlPasteValues
    End With
' Sheet 2
With Sheets("2 - Elbows")
    .Range("A:B").AutoFilter Field:=1, Criteria1:="x"
    .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy
    End With
With Sheets("work")
    Last_Row0 = ws0.Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & Last_Row0).PasteSpecial xlPasteValues
    End With

' Not Sure
' Sheet 1
With Sheets("1 - Conduit")
    ActiveSheet.Range("A:C").AutoFilter
    End With
' Sheet 2
With Sheets("2 - Elbows")
    ActiveSheet.Range("A:C").AutoFilter
    End With
End Sub

我更喜欢在“While”或“For”循环中执行此操作。我想我是正确的，但是当我运行它时，它没有执行。这是我写的，然后我会评论我认为我的问题。

Private Sub Load_Order_Click()
' Setup Data
    Dim Last_Row0 As Long
    Dim ws0 As Worksheet
    Dim i As Integer           ' Copy loop
    Dim x As Integer           ' "Not Sure" loop
    Dim max As Integer         ' Maximum number of pages Adjustment
    Dim pages As Integer       ' Number of Worksheets to copy through

    Set ws0 = Sheets("work")
    Set pages = 30
    Set max = pages + 1

' Sort and Copy Data from each page to Work - Loop Function
For i = 1 to max
    If i = 1 Then
        Sheets("1 - Conduit").Activate
        .Range("A:B").AutoFilter Field:=1, Criteria1:="x"
        .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy
        Sheets("work").Activate
        .Range("A1").PasteSpecial xlPasteValues
    Else
        Sheets("1 - Conduit").Activate
        Worksheets(ActiveSheet.Index + (i - 1)).Select
        .Range("A:B").AutoFilter Field:=1, Criteria1:="x"
        .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy
        Sheets("work").Activate
        Last_Row0 = ws0.Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A1").PasteSpecial xlPasteValues
    End If
Next i

' Not Sure
For x = 1 to max
    Sheets("1 - Conduit").Activate
    Worksheets(ActiveSheet.Index + (i - 1)).Select
    ActiveSheet.Range("A:C").AutoFilter
Next x
End Sub

我认为代码是正确的。我认为我的问题在于 excel 文件的原始创建者是如何制作工作表的。

这就是我的意思。我需要检查工作表（这些是选项卡上工作表的名称）： 1 - 导管； 2 - 肘部，3 - *****； 4 - ******； 5 - ******； 6 - ******（你明白了）。但是，当我查看 VBA 代码窗口时，工作表的编号如下：

表 1 = 4 - *****; Sheet2 = 7 - *****; Sheet3 = 1 - *****; Sheet4 = 2 - *****; Sheet5 = 订单（不是要扫描的工作表）

而且我相信当我逐步执行时，我正在对“Sheet#”进行索引，并且由于我需要检查的工作表都按顺序搞砸了，所以我发现代码只是放弃了。

所以我的问题是这样的：

1. 我的代码正确吗？还是我做错了什么？
2. 我的假设是否正确，我需要创建一个全新的 Excel 工作簿，并确保前 4 个工作表是不扫描的工作表，然后从 Sheet5 索引？

Answer 1

我已经指出了您代码中的几个错误。在这里，您可能会在我的 cmets 中看到代码的更新版本。我已经检查了 vba 控制台中的调试器，它可以正常工作。但是，我不确定它是否适用于您的数据。

Private Sub Load_Order_Click()
' Setup Data
    Dim Last_Row0 As Long
    Dim ws0 As Worksheet
    Dim i As Integer           ' Copy loop
    Dim x As Integer           ' "Not Sure" loop
    Dim max As Integer         ' Maximum number of pages Adjustment
    Dim pages As Integer       ' Number of Worksheets to copy through

    Set ws0 = Sheets("work")
    '======================================
    'you don't need to set an integer;
    'just assign a value as below
    '======================================
    pages = 30
    max = pages + 1

' Sort and Copy Data from each page to Work - Loop Function
For i = 1 To max
    If i = 1 Then
        Sheets("1 - Conduit").Activate
        '======================================
        ' You have to begin with activesheet like below
        '======================================
        With ActiveSheet
        .Range("A:B").AutoFilter Field:=1, Criteria1:="x"
        .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy
        Sheets("work").Activate
        'here is another confusing line
        .Range("A1").PasteSpecial xlPasteValues
        End With

    Else
        Sheets("1 - Conduit").Activate
        Worksheets(ActiveSheet.Index + (i - 1)).Select
        '======================================
        ' same here
        '======================================
        With ActiveSheet
        .Range("A:B").AutoFilter Field:=1, Criteria1:="x"
        .Range("a2", .Cells.SpecialCells(xlCellTypeLastCell)).Copy
        Sheets("work").Activate
        Last_Row0 = ws0.Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A1").PasteSpecial xlPasteValues
        End With
    End If
Next i

' Not Sure
For x = 1 To max
    Sheets("1 - Conduit").Activate
    Worksheets(ActiveSheet.Index + (i - 1)).Select
    ActiveSheet.Range("A:C").AutoFilter
Next x
End Sub