使用 VBA 復制並粘貼下一個空行的值

Question

嘗試從工作表中的同一行數據復制並將值粘貼到數據集中的下一個空行中。

在附圖中，我的代碼從底部的灰色數據條中復制並將這些值粘貼到頂部的下一個空數據行中

在附圖中，我的代碼從底部的灰色數據條中復制並將這些值粘貼到頂部的下一個空數據行中

這就是我得到的 - 請幫忙。 我的問題是如何讓它在數據集中的下一個空行上粘貼值

    Range("B412:O412").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B390").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("P389:Z389").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("P390").Select
    ActiveSheet.Paste
End Sub

Answer 1

將范圍復制到另一個工作表

最終的

Option Explicit

Sub CopyTwoRange()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "B").End(xlUp).Row

    Dim srg As Range
    Dim dCell As Range
    
    Set srg = sws.Range("B412:O412")
    Set dCell = dws.Cells(dlRow, "B").Offset(1)
    dCell.Resize(, srg.Columns.Count).Value = srg.Value
    
    Set srg = sws.Range("P389:Z389")
    Set dCell = dws.Cells(dlRow, "P").Offset(1)
    dCell.Resize(, srg.Columns.Count).Value = srg.Value

End Sub

一個范圍

Sub Lesson()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source (Copy FROM (Read))
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    Dim srg As Range: Set srg = sws.Range("B412:O412")
    
    ' Destination (Copy TO (Paste, Write))
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    ' Last Row
    Dim dlRow As Long
    
    ' Last non-empty row in column `B` using 'End' (most popular, easy).
    dlRow = dws.Cells(dws.Rows.Count, "B").End(xlUp).Row
    
'    ' Last non-empty row in column 'B' using 'Find'.
'    dlRow = dws.Columns("B").Find("*", , xlFormulas, , , xlPrevious).Row
'
'    ' Last NON-BLANK row in column 'B' using 'Find'. Useful when there are
'    ' many formulas evaluating to an empty string ("") at the bottom and
'    ' you want to exclude them.
'    dlRow = dws.Columns("B").Find("*", , xlValues, , , xlPrevious).Row
    
    ' With 'Offset(1)', the cell BELOW the last row is referenced.
    Dim dCell As Range: Set dCell = dws.Cells(dlRow, "B").Offset(1)
    
    ' Copy
    
    ' Copy ONLY VALUES (copy by assignment)
    dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
    
'    ' Copy values and formats and formulas
'    srg.Copy dCell ' short for srg.Copy Destination:=dCell
'
'    ' Copy values and/or formats and/or formulas and/or column widths...
'    srg.Copy
'    dCell.PasteSpecial ' many options
'    Application.CutCopyMode = False
    
End Sub
    

兩個范圍

Sub LessonLearned()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    Dim srg As Range: Set srg = sws.Range("B412:O412")
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "B").End(xlUp).Row

    Dim dCell As Range: Set dCell = dws.Cells(dlRow, "B").Offset(1)
    
    ' Since you are copying only one row, you can use...
    dCell.Resize(, srg.Columns.Count).Value = srg.Value
'    ' ... which is short of...
'    dCell.Resize(1, srg.Columns.Count).Value = srg.Value
'    ' ...instead of ...
'    dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
    
    ' Since the results from the first one-row range go into the same row
    ' adjacent to the first range you could do:
    With sws.Range("P389:Z389")
        dCell.Offset(, srg.Columns.Count) _
            .Resize(, .Columns.Count).Value = .Value
    End With
    ' ... where the columns count of the previous range is used as the offset,
    ' while the columns count of the current range is used with 'Resize'.
    
    ' Of course, this may be too advanced at this moment so you should use...
    
    Set srg = sws.Range("P389:Z389")
    ' If the last rows are different then do:
    'dlRow = dlRow = dws.Cells(dws.Rows.Count, "P").End(xlUp).Row
    Set dCell = dws.Cells(dlRow, "P").Offset(1)
    dCell.Resize(, srg.Columns.Count).Value = srg.Value

End Sub