VBA to Insert Data in next available row that isn't the total row at the Bottom of the Worksheet - excel

Question

I have two Workbooks that I need to copy/paste data from one workbook into the next available row in another workbook. The code I have below is almost working. You see, there is a total row at the bottom of the destination workbook. So, I'm trying to figure out how to insert a row at the next available row from the top, but instead, my code inserts the data below the totals row.
Here's how it looks in Excel. I'm trying to insert what would be Row C, but instead it inserts below the "Totals" row:
Row A 1 2 3 4
Row B 2 3 4 5
<-----Trying to Insert Here---------->
Totals 3 5 7 9
Here's my code"
:
Sub sbCopyToDestination()
Dim SourceRange As Range
Set SourceRange = ThisWorkbook.Worksheets("Sheet1").Range("f34:l34")
Dim NextFreeCell As Range
Set NextFreeCell = Workbooks("Destination.xlsm").Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(RowOffset:=1)
SourceRange.Copy
NextFreeCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ThisWorkbook.Save
End Sub

Answer 1

Try the next code, please. It also updates the total, to include the pasted values.
Dim SourceRange As Range, destSh As Worksheet, NextFreeCell As Range
Set SourceRange = Range("f34:l34") ' ThisWorkbook.Worksheets("Sheet1").Range("f34:l34")
Set destSh = Workbooks("Book1").Worksheets("Sheet1") ' Workbooks("Destination.xlsm").Worksheets("Sheet1")
Set NextFreeCell = destSh.cells(Rows.count, "B").End(xlUp)
Application.CutCopyMode = 0
NextFreeCell.EntireRow.Insert xlDown
NextFreeCell.Offset(-1).Resize(, 2).Value = SourceRange.Value
'if you do not need to update the sum formula with the new inserted row, coamment the next row
NextFreeCell.Formula = UpdateFormula(NextFreeCell)
NextFreeCell.Offset(, 1).Formula = UpdateFormula(NextFreeCell.Offset(, 1))
ThisWorkbook.Save
End Sub
Function UpdateFormula(rng As Range) As String
Dim x As String
x = rng.Formula
UpdateFormula = Replace(x, Split(x, ":")(1), _
Replace(Split(x, ":")(1), rng.Row - 2, rng.Row - 1))
End Function

Answer 2

Try this
Sub sbCopyToDestination()
Dim SourceRange As Range
Set SourceRange = ThisWorkbook.Worksheets("Sheet1").Range("f34:l34")
Dim NextFreeCell As Range
Set NextFreeCell = Workbooks("Destination.xlsm").Worksheets("Sheet1").Cells(Rows.count, "B").End(xlUp) ' No offset
With SourceRange
NextFreeCell.Resize(.Rows.count, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
NextFreeCell.Resize(.Rows.count, .Columns.count).Value = .Value
End With
ThisWorkbook.Save
End Sub