Question

我正在尝试做一个简单的复制行，在工作簿中粘贴行。我已经搜索了线程，并尝试多次更改我的代码，但无济于事。

最接近工作的是这个，但它只复制匹配条件的单个实例。

我正在尝试创建一个循环，它将复制其中一列中匹配的所有行。

因此，如果是8列，则第7列中具有匹配值的每一行都应复制到命名工作表。

＆＃13;

Sub test()
Set MR = Sheets("Main").Range("H1:H1000")
Dim WOLastRow As Long, Iter As Long

    For Each cell In MR
    
If cell.Value = "X" Then
cell.EntireRow.Copy
Sheets("X").Range("A" & Rows.Count).End(xlUp).PasteSpecial
    End If
If cell.Value = "Y" Then
cell.EntireRow.Copy
Sheets("Y").Range("A" & Rows.Count).End(xlUp).PasteSpecial
    End If
If cell.Value = "Z" Then
cell.EntireRow.Copy
Sheets("Z").Range("A" & Rows.Count).End(xlUp).PasteSpecial
    End If
If cell.Value = "AB" Then
cell.EntireRow.Copy
Sheets("AB").Range("A" & Rows.Count).End(xlUp).PasteSpecial
    End If
    
Application.CutCopyMode = False

Next

End Sub

＆＃13;

我喜欢这个，因为我需要使用不同的条件定位多个目标表，但我需要符合条件的所有行进行复制。

Answer 1

根据新要求编辑的编码：

下面的代码将复制工作表Main中的所有行，并根据第7列中的值将它们粘贴到相应的工作表中。

请注意：如果第7列中的值与现有工作表名称不匹配，则代码将引发错误。修改代码以处理该异常。

让我知道任何其他需要的帮助。

Sub CopyStuff()
    Dim wsMain As Worksheet
    Dim wsPaste As Worksheet
    Dim rngCopy As Range
    Dim nLastRow As Long
    Dim nPasteRow As Long
    Dim rngCell As Range
    Dim ws As Worksheet

    Const COLUMN_TO_LOOP As Integer = 7

    Application.ScreenUpdating = False

    Set wsMain = Worksheets("Main")
    nLastRow = wsMain.Cells(Rows.Count, 1).End(xlUp).Row
    Set rngCopy = wsMain.Range("A2:H" & nLastRow)

    For Each ws In ActiveWorkbook.Worksheets
        If UCase(ws.Name) = "MAIN" Then
            'Do Nothing for now
        Else
            Intersect(ws.UsedRange, ws.Columns("A:H")).ClearContents
        End If
    Next ws

    For Each rngCell In Intersect(rngCopy, Columns(COLUMN_TO_LOOP))
        On Error Resume Next
        Set wsPaste = Worksheets(rngCell.Value)
        On Error GoTo 0

        If wsPaste Is Nothing Then
            MsgBox ("Sheet name: " & rngCell.Value & " does not exist")
        Else

            nPasteRow = wsPaste.Cells(Rows.Count, 1).End(xlUp).Row + 1

            wsMain.Range("A" & rngCell.Row).Resize(, 8).Copy wsPaste.Cells(nPasteRow, 1)
        End If

        Set wsPaste = Nothing
    Next rngCell

    Application.ScreenUpdating = True
End Sub

Answer 2

您当前的代码一遍又一遍地粘贴到每个工作表中的同一行，并在A列中输入一个值的最后一行。Range("A" & Rows.Count).End(xlUp)说，大致“转到A列电子表格的最底部，然后从那里跳到A列中包含内容的下一个最低单元格，“每次都会让你回到同一个单元格。

相反，您可以使用模式的行：

Sheets("X").Range("A" & Sheets("X").UsedRange.Rows.Count + 1).PasteSpecial

其中UsedRange是一个范围，其中包含工作表中包含数据的所有单元格。 + 1会让您进入下一行。

你可以使用With：

使这更漂亮

With Sheets("X")    
  .Range("A" & .UsedRange.Rows.Count + 1).PasteSpecial    
End With

在VBA中复制/粘贴多行

2 个答案: