将范围复制到不同 sheet 中的下一个空闲行

Question

我需要复制一个范围（Sheet2 B2:S2），将其粘贴到第 7 行后第一个空闲行上的相同 sheet 上，将相同的数据粘贴到 Sheet1 上的第一个空行然后清空原来范围(Sheet2B2:S2)的内容，为下一个条目做好准备。

我尝试过使用其他帖子，但我不知道该怎么做。

这是简单的宏

 Sub Macro2()
'
' Macro2 Macro
'

'
    Sheets("Sheet2").Select
    Range("B2:S2").Select
    Selection.Copy
    Range("B7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("B2:S2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub

它粘贴在最后一行。我需要它在粘贴时找到下一个空闲行。

Answer 1

试试这个，通过删除您的 select 语句进行整理：

Sub Macro2()
Dim SourceRange, TargetRange1, TargetRange2 As Range
Dim RowToPaste As Long
   'set range of source data
   Set SourceRange = Sheets("Sheet2").Range("B2:S2")
   'cater for chance that less than 7 rows are populated - we want to paste from row 8 as a minimum
   If (Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1) < 8 Then
      RowToPaste = 8
   Else
      'Add 1 to the value of the last populated row
      RowToPaste = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1
   End If
   'Set the address of the target 1 range based on the last populated row in column B
   Set TargetRange1 = Sheets("Sheet2").Range("B" & RowToPaste)
   'Copy Source to target 1
   SourceRange.Copy Destination:=TargetRange1
   'Cater for Sheet 1 being totally empty and set target row to 1
   If Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row = 1 And _
    Len(Sheets("Sheet1").Range("A1")) = 0 Then
      RowToPaste = 1
   Else 'set target row to last populated row + 1
      RowToPaste = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
   End If
   'Set the target 2 range based on the last empty row in column A
   Set TargetRange2 = Sheets("Sheet1").Range("A" & RowToPaste)
   'Paste the source to target 2
   SourceRange.Copy Destination:=TargetRange2
   'Clear the source data
   SourceRange.ClearContents
End Sub

Answer 2

你太接近了！问题是您永远不会增加目标 range 对象——它总是设置为 Range("B7")。以下大量注释的代码应该可以实现您的目标：

Option Explicit
Public Sub MoveRowFrom2To1()

Dim shtSource As Worksheet, shtResult As Worksheet
Dim rngSource As Range, rngResult As Range
Dim lngLastRowOnSheet1 As Long, lngLastRowOnSheet2 As Long

'Set references up-front
Set shtSource = ThisWorkbook.Worksheets("Sheet2")
Set shtResult = ThisWorkbook.Worksheets("Sheet1")

'Identify the last occupied row on Sheet1 and Sheet2
lngLastRowOnSheet1 = LastRowNum(shtResult)
lngLastRowOnSheet2 = LastRowNum(shtSource)

'If the last occupied row is < 7, default to 6 so it writes to 7
If lngLastRowOnSheet2 < 7 Then
    lngLastRowOnSheet2 = 6
End If

'Identify the Source data and Sheet2 Destination
Set rngSource = shtSource.Range("B2:S2")
Set rngResult = shtSource.Cells(lngLastRowOnSheet2 + 1, 2) '<~ column 2 is B

'Copy the Source data from Sheet2 to lower on Sheet2
rngSource.Copy
rngResult.PasteSpecial (xlPasteValues)

'Identify the Sheet1 Destination
Set rngResult = shtResult.Cells(lngLastRowOnSheet1 + 1, 2) '<~ column 2 is B

'Paste the Source data from Sheet2 onto Sheet1
rngResult.PasteSpecial (xlPasteValues)

'Clear the Source range in anticipation of a new entry
rngSource.ClearContents

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 0
Public Function LastRowNum(Sheet As Worksheet) As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        LastRowNum = Sheet.Cells.Find(What:="*", _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
    Else
        LastRowNum = 0
    End If
End Function

将范围复制到不同 sheet 中的下一个空闲行

Copy range to next free row in a different sheet

excel

vba