VBA-根据文本将数据从一张纸传输到另一张纸，并将其放入另一张纸的特定位置

Question

这将是数据，我希望能够从sheet4中取出所有PP，并将它们粘贴到A11：A22的特定范围内的PDH_Handvoer表中。然后，也将FA粘贴到同一张纸上，但粘贴范围为A30：A42，因此每个字母一个。

到目前为止，这是代码，但它并没有完成我需要的操作

Private Sub CommandButton1_Click()


Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet4")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("PDH_Handover")

Dim LRow1 As Long, LRow2 As Long, i As Long
LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row

For i = 2 To LRow1
    If ws1.Cells(i, 1) = "pp" Then
        ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
        ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues
    End If
Next
End Sub 

Answer 1

您的代码正在运行，只需在粘贴新行后重新获取LRow2值-否则，您总是会覆盖第一行（在这种情况下，您最后复制的行为空白，因此它看起来 好像什么都没有发生。

作为一种很好的做法，我还在末尾添加了Application.CutCopyMode = False（清除剪贴板）。

Private Sub CommandButton1_Click()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet4")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("PDH_Handover")

Dim LRow1 As Long, LRow2 As Long, i As Long
LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row

For i = 2 To LRow1
    If ws1.Cells(i, 1) = "PP" Then
        ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
        ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues

        'Get new last row value
        LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
    End If
Next

Application.CutCopyMode = False

End Sub

相反，让我们完全摆脱Copy/Paste，因为最好避免依赖于ActiveSheet的语法：

Private Sub CommandButton1_Click()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet4")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("PDH_Handover")

Dim LRow1 As Long, LRow2 As Long, i As Long
LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row

For i = 2 To LRow1
    If ws1.Cells(i, 1) = "PP" Then
        ws2.Range(ws2.Cells(LRow2 + 1, 1), ws2.Cells(LRow2 + 1, 4)).Value = _
        ws1.Range(ws1.Cells(i, 2), ws1.Cells(i, 5)).Value

        'Get new last row value
        LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
    End If
Next

End Sub

Answer 2

如果我们第一次获得正确的LRow2值，我更愿意 LRow2 = LRow2 + 1 但不要 End（xlUp）.row

Private Sub CommandButton1_Click()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim LRow1 As Long, LRow2 As Long, i As Long

Set ws1 = Application.ThisWorkbook.Sheets("Sheet4")
Set ws2 = Application.ThisWorkbook.Sheets("PDH_Handover")
LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).row
LRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).row

For i = 2 To LRow1
    If ws1.Cells(i, 1) = "PP" Then
        ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
        ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues

        'Get new last row value
        LRow2 = LRow2 + 1
    End If
Next

结束子