Question

我试图在该论坛中寻找答案，我也试图修改代码以适合我的要求，但仍然没有成功。有人可以帮我吗？

我有一个6页的Excel文档。 所有工作表都具有相同（固定）的表格。前5张纸基本上是数据库，其中有5个不同项目的电气零件，而6张纸是空表格，应该用作订单清单。

我需要的是一个代码，如果满足条件，它将把整个行从工作表1/2/3/4/5复制到工作表6。准则是在C列（Sheets 1/2/3/4/5）中输入的数量（不同于0）。那是主要问题，我需要将整行复制到工作表6中的下一个空行–但是表单从第14行（A14）开始，上面是一个标题。

现在我有了命令按钮的代码，仅当我在一张工作表中尝试将行复制到工作表6（订单列表）时，该按钮才有效。如果我在工作表5中工作，例如跳到工作表3，并且如果我尝试从工作表3中向订单清单中添加更多零件，它将只复制订单清单中所有现有零件，而我已经从中复制了这些零件工作表5。

这是我到目前为止的代码（在本示例中，我仅使用工作表5-“ Gemeinsam”）：

Private Sub CommandButton1_Click()
    a = Worksheets("Gemeinsam").Cells(Rows.Count, 5).End(xlUp).Row
    b = 14
    For i = 14 To a

       If Worksheets("Gemeinsam").Cells(i, 3).Value > 0 Then

          Worksheets("Gemeinsam").Rows(i).Copy
          Worksheets("Stückliste").Activate
          Worksheets("Stückliste").Cells(b, 1).Select
          ActiveSheet.Paste
          Worksheets("Gemeinsam").Activate
       b = b + 1
       End If
    Next

Application.CutCopyMode = False

ThisWorkbook.Worksheets("Gemeinsam").Cells(14, 1).Select

End Sub

Answer 1

这假定您在工作簿中只有6个工作表。某些变量名已更改，但希望可以理解。

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim DestLastRow As Long
    Dim LastRow As Long
    Dim i As Long

    Set ws1 = Sheets("Stückliste")

    For Each ws In Worksheets
        If ws.Name <> "Stückliste" Then
            LastRow = ws.Cells(Rows.Count, 5).End(xlUp).Row
            For i = 14 To LastRow
                If ws.Cells(i, 3).Value > 0 Then
                    DestLastRow = ws1.Cells(Rows.Count, 5).End(xlUp).Row + 1
                    ws.Rows(i).Copy ws1.Rows(DestLastRow)
                End If
            Next i
        End If
    Next ws

    Application.CutCopyMode = False

End Sub

从特定行开始，将整个行复制到另一个工作表中的下一个空行

1 个答案: