时间戳

首页 > 解决方案 > VBA-如何开始粘贴到某个单元格

vba - 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

标签： vbaexcel

解决方案

您可以采取的一种方法如下

  • 设置与每个代码相关的特定范围

    我会使用Select Case构造而不是构造If ...Then... Else If ...End IF，因为前者更清楚地检查不同可能的值

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

如下：

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

推荐阅读