VBA 将粘贴的行设置为范围
VBA Set Pasted Rows as Range
下面是从 sheet“模板”复制范围并粘贴到活动 Sheet 上的第一个空白行的部分代码。第 1 行是 Header 行。
我想要做的是引用刚刚粘贴的行,然后 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
请尝试下一个代码。它将对所有粘贴的行进行分组,第一行除外:
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
下面是从 sheet“模板”复制范围并粘贴到活动 Sheet 上的第一个空白行的部分代码。第 1 行是 Header 行。
我想要做的是引用刚刚粘贴的行,然后 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
请尝试下一个代码。它将对所有粘贴的行进行分组,第一行除外:
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