excel - 如何将数据粘贴到第一个空行的列中？

Question

我正在寻找一种将数据粘贴到特定列的第一个空行中的解决方案。
以下函数正确复制和粘贴数据，但不能正确复制和粘贴特定列的第一个空行。

Sub Test()

Application.ScreenUpdating = False
Dim i As Integer
Dim Lastrow As Long

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To Lastrow

    If Cells(i, 1).Value = "cav. 1" Then

        Cells(i, 11).Offset(0, 10).Value = Cells(i, 11).Value
        
    End If

    If Cells(i, 1).Value = "cav. 2" Then
    Cells(i, 11).Offset(0, 11).Value = Cells(i, 11).Value
    End If
    
Next
Application.ScreenUpdating = True
End Sub

Answer 1

复制到其他列，不在同一行

Option Explicit

Sub Test()
    
    ' Source
    Const sfRow As Long = 2 ' First Row
    Const slCol As String = "A" ' lookup
    Const srCol As String = "K" ' result
    Const sCrit1 As String = "cav. 1"
    Const sCrit2 As String = "cav. 2"
    
    ' Destination
    Const dfRow As Long = 2 ' First Row
    Const dCol1 As String = "U"
    Const dCol2 As String = "V"

    Application.ScreenUpdating = False

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    
    Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, slCol).End(xlUp).Row
    Dim dr1 As Long: dr1 = dfRow
    Dim dr2 As Long: dr2 = dfRow
    
    Dim sr As Long
    
    For sr = sfRow To slRow
        Select Case LCase(CStr(ws.Cells(sr, slCol).Value))
        Case sCrit1
            ws.Cells(dr1, dCol1).Value = ws.Cells(sr, srCol).Value
            dr1 = dr1 + 1
        Case sCrit2
            ws.Cells(dr2, dCol2).Value = ws.Cells(sr, srCol).Value
            dr2 = dr2 + 1
        End Select
    Next sr

    Application.ScreenUpdating = True

End Sub