0
votes

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.

2

2 Answers

0
votes

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
0
votes

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