Question

任何人都可以帮我报告这件事！？我想使用Sheet1的第7列中的每个值作为参数，并将其复制到Sheet2，如果Sheet2具有此参数，则使用sheet1的第1列中的值在Sheet2的第30列中搜索，如果它符合条件，然后将sheet2中的整行复制到新的sheet3

Sub test()

    ' Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet3"
    ' FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

    LastRow_Sheet1 = Worksheets("Sheet1").UsedRange.Rows.Count
    LastRow_Sheet2 = Worksheets("Sheet2").UsedRange.Rows.Count

    For x = 2 To LastRow_Sheet1

        po_number = Worksheets("Sheet1").Cells(x, 7).Value
        site_name = Worksheets("Sheet1").Cells(x, 1).Value
        Worksheets("Sheet2").Activate

        For y = 2 To LastRow_Sheet2
            If po_number <> Worksheets("Sheet1").Cells(y, 1).Value Then
                If InStr(1, CStr(site_name), Worksheets("Sheet2").Cells(y, 30)) >= 1 Then
                    Range("Cells(y, 1):Cells(y,31)").Copy
                    Sheets("Sheet3").Select
                    NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                    Cells(NextRow, 1).Select
                    ActiveSheet.Paste
                End If
            End If

        Next
    Next

End Sub

根据Scott的建议，我将代码更改如下，子测试（）

LastRow_Sheet1 = Worksheets("Sheet1").UsedRange.Rows.Count
LastRow_Sheet2 = Worksheets("Sheet2").UsedRange.Rows.Count

For x = 2 To 2

    po_number = Worksheets("Sheet1").Cells(x, 7).Value
    site_name = Worksheets("Sheet1").Cells(x, 1).Value

    For y = 2 To 20000
        If po_number <> Worksheets("Sheet2").Cells(y, 1).Value Then
        With Worksheets("Sheet2") ' I ASSUME THIS IS THE SHEET YOU WANT TO WORK WITH. CHANGE AS NECESSARY
            If InStr(1, CStr(site_name), .Cells(y, 30)) >= 1 Then
                Range(Cells(y, 1), Cells(y, 31)).Copy
                nextRow = Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, 1).End(xlUp).Row + 1
                Sheets("Sheet3").Range("A" & nextRow).PasteSpecial
                'You may need to change this. I am not sure what range you were wanting to paste to
            End If
          End With
        End If
    Next
Next

End Sub

但没有人复制到Sheet3大声笑......而且，我想知道这条线代表什么Sheets("Sheet3").Range("A" & nextRow).PasteSpecial？

非常感谢！

Answer 1

如果我理解正确，我想你想要这个：

Sub test()

    LastRow_Sheet1 = Worksheets("Sheet1").UsedRange.Rows.Count
    LastRow_Sheet2 = Worksheets("Sheet2").UsedRange.Rows.Count

    For x = 2 To LastRow_Sheet1

        po_number = Worksheets("Sheet1").Cells(x, 7).Value
        site_name = Worksheets("Sheet1").Cells(x, 1).Value

        For y = 2 To LastRow_Sheet2
            If po_number <> Worksheets("Sheet1").Cells(y, 1).Value Then
            With Worksheets("Sheet2") ' I ASSUME THIS IS THE SHEET YOU WANT TO WORK WITH. CHANGE AS NECESSARY
                If InStr(1, CStr(site_name), .Cells(y, 30)) >= 1 Then
                    nextRow = Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, 1).End(xlUp).Row + 1
                    .Range(.Cells(y, 1), .Cells(y, 31)).Copy Sheets("Sheet3").Range("A" & nextRow)
                End If
              End With
            End If
        Next
    Next
End Sub

正如评论中所提到的，主要问题是您的行Range("Cells(y, 1):Cells(y,31)").Copy。此外，请务必使用您希望运行的工作表来限定所有Range()，Cells()，Rows.Count等。另外，我尝试删除.Activate/.Active的所有实例。范围可能需要调整，所以如果这不起作用，请告诉我。

Excel将整行复制到其他工作表

1 个答案: