Скопируйте диапазон в следующую свободную строку на другом листе

Question

Мне нужно скопировать диапазон (Sheet2 B2: S2), вставить его на том же листе в первой свободной строке после строки 7, вставить те же данные в первую пустую строку на Sheet1, а затем очистить содержимое исходного диапазона (Sheet2 B2: 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

Ты так близко! Проблема в том, что вы никогда не увеличиваете целевой объект 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 

Answer 2

Попробуйте это уже прибрано путем удаления ваших операторов выбора:

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