VBA将粘贴的行设置为范围

时间:2021-07-26 09:00:24

标签: excel vba range copy-paste

下面是从工作表“模板”复制范围并粘贴到活动工作表上的第一个空白行的代码的一部分。第 1 行是标题行。

我想要做的是引用刚刚粘贴的行,然后 Group 行。

我的 VBA 很差,我不确定如何正确设置“PastedRange”。我怎么能做到这一点?

    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim LRow As Long
    Dim PastedRange As Range

    Set copySheet = ThisWorkbook.Worksheets("Template")
    Set pasteSheet = ThisWorkbook.ActiveSheet
    Set PastedRange = .Range("A" & .Rows.Count).End(xlUp).Row
    
    With pasteSheet
        '~~> Find the last cell to write to
        If Application.WorksheetFunction.CountA(.Cells) = 0 Then
            LRow = 2
        Else
            LRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        End If

        copySheet.Range("2:" & copySheet.Cells(Rows.Count, _ 
        1).End(xlUp).Row).Copy
        .Rows(LRow).PasteSpecial Paste:=xlPasteAll
        PastedRange.Group
    End With

1 个答案:

答案 0 :(得分:1)

请尝试下一个代码。它将对所有粘贴的行进行分组,除了第一行:

Sub testGroupRows()
   Dim copySheet As Worksheet, pasteSheet As Worksheet, LRow As Long, csLastRow As Long

    Set copySheet = ThisWorkbook.Worksheets("Template")
    Set pasteSheet = ThisWorkbook.ActiveSheet
    
    With pasteSheet
        '~~> Find the last cell to write to
        If Application.WorksheetFunction.CountA(.cells) = 0 Then
            LRow = 2
        Else
            LRow = .Range("A" & .rows.count).End(xlUp).row + 1
        End If
        'if the summary row is not above, set it to be above:
        If .Outline.SummaryRow <> xlSummaryAbove Then .Outline.SummaryRow = xlSummaryAbove
        
        csLastRow = copySheet.cells(rows.count, 1).End(xlUp).row
        copySheet.Range("2:" & csLastRow).Copy
        .rows(LRow).PasteSpecial Paste:=xlPasteAll
        
        'group skipping the first copied row:
        .Range(.cells(.rows.count, 1).End(xlUp), .cells(.rows.count, 1).End _
                                       (xlUp).Offset(-(csLastRow - 3), 1)).EntireRow.Group
    End With
End Sub
相关问题