VBA-如何开始粘贴到特定单元格

我有一个选择某个代码的代码，它复制它的行并将其粘贴到另一个表中。我需要让每个代码字开始粘贴到新工作表中的某个单元格中。例如：将代码PP粘贴到A11、A12、A13…等中，将代码FA粘贴到A23、A24…等中

这是迄今为止的代码：

   Private Sub CommandButton2_Click()
 Dim ws1 As Worksheet, ws2 As Worksheet
 Dim LRow1 As Long, LRow2 As Long, i As Long

Set ws1 = Application.ThisWorkbook.Sheets("Sheet1")
Set ws2 = Application.ThisWorkbook.Sheets("sheet5")
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

   ElseIf ws1.Cells(i, 1) = "FA" Then
        ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
        ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues

     LRow2 = LRow2 + 1

ElseIf ws1.Cells(i, 1) = "IA" Then
    ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
    ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues
    LRow2 = LRow2 + 1

ElseIf ws1.Cells(i, 1) = "P" Then
    ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
    ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues
    LRow2 = LRow2 + 1

 ElseIf ws1.Cells(i, 1) = "PR" Then
    ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
    ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues
    LRow2 = LRow2 + 1

ElseIf ws1.Cells(i, 1) = "CK" Then
    ws1.Range(Cells(i, 2), Cells(i, 5)).Copy
    ws2.Range("A" & LRow2 + 1).PasteSpecial xlPasteValues
    LRow2 = LRow2 + 1

 End If
Next

End Sub

---

你可以通过以下方法来实现

• 设置与每个代码相关的特定范围
  我会使用

  selectcase

  结构，而不是

  If…Then。。。Else If…End If

  1，因为前者更清楚地检查不同可能值的值

• 计算特定范围内已非空单元格的数量，并从下面的单元格开始粘贴值

详情如下:

Private Sub CommandButton2_Click()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim LRow1 As Long, LRow2 As Long, i As Long

    Set ws1 = Application.ThisWorkbook.Sheets("Sheet1")
    Set ws2 = Application.ThisWorkbook.Sheets("sheet5")
    LRow1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row

    Dim rng As Range
    For i = 2 To LRow1
        Select Case ws1.Cells(i, 1)
            Case "PP"
                Set rng = ws2.Range("A11:A22") 'PP codes related range is A11:A22 in worksheet ws2  
            Case "FA"
                Set rng = ws2.Range("A23:A34") 'PP codes related range is A23:A34 in worksheet ws2   
            Case "IA"
                Set rng = ws2.Range("A35:A46") ' and so on
            Case "P"
                Set rng = ws2.Range("A47:A58")
            Case "PR"
                Set rng = ws2.Range("A59:A70")
            Case "CK"
                Set rng = ws2.Range("A71:A82")
            Case Else
                Set rng = Nothing
        End Select

        If Not rng Is Nothing Then
            LRow2 = WorksheetFunction.Count(rng) ' count the not empty cell in set range
            rng(LRow2 + 1).Resize(, 4).Value = ws1.Range(ws1.Cells(i, 2), ws1.Cells(i, 5)).Value ' copy values only
        End If
    Next
End Sub

---

你能澄清一下你想做什么吗？这有点不明确，因为它会将

Select Case ws1.Cells（i，1）

更改为

Select Case ws1.Cells（i，1）.Value

，因此您显式引用的是单元格的值，而不是

范围

对象。如果您知道代码为什么要跳过中间值，请假设我有一个包含三个“PP”的表，它将只复制和粘贴第一个和最后一个数据。