Question

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

我成功地编写了一些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代码窗口中查看时，工作表的编号如下：

Sheet1 = 4-*****; Sheet2 = 7-*****; Sheet3 = 1-*****; Sheet4 = 2-*****; Sheet5 =订单（不是要扫描的纸张）

我相信当我逐步执行时，我正在为“ Sheet＃”建立索引，并且由于我需要检查的工作表都按顺序弄乱了，所以我得出的结论是代码只是放弃了。

所以我的问题是这个

我的代码正确吗？还是我做错了什么？
我的假设是否正确，我需要创建一个全新的excel工作簿并确保前四个工作表是不被扫描的工作表，然后从Sheet5中索引出来？

Answer 1

我已经指出了您的代码中的几个错误。在这里，您可能会看到带有我的注释的代码的更新版本。我已经在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

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

1 个答案: