Copy range to next free row in a different sheet - vba

Question

I need to copy a range (Sheet2 B2:S2), paste it on the same sheet on the first free row after row 7, paste the same data to the first empty row on Sheet1 and then clear the contents of the original range (Sheet2 B2:S2) ready for the next entry.
I have tried to use other posts but I can't figure out what to do.
Here is the macro that does the easy bit
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
It pastes over the last line. I need it to find the next free line when pasting.

Answer 1

You're so close! The issue is that you never increment the destination range object -- it's always set to Range("B7"). The following heavily-commented code should achieve what you're after:
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

Try this, have tidied up by removing your select statements:
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