Insert copied data before Totals line

[Robert Germain]

Hi all,

I have this code (thank you Fluff) where it copies and pastes data in the last empty line in a worksheet. I would need to improve on that by ensuring that this code takes into consideration that the last non empty line is my Totals line and therefore it has to insert the copied data above this line and to respect the formatting of the rows and columns in the process. The inserted data may vary in the amount of rows to be pasted.

Thank you for your assistance in advance!

Code
Sub Copy_data_2()

Dim Ws As Worksheet
Dim Sht As String
Dim LASTROW As Long

Sht = InputBox("Please enter sheet name")
On Error Resume Next
Set Ws = Workbooks("2018_CONTABILIDAD TOTAL.xlsm").Sheets(Sht)
On Error GoTo 0
If Ws Is Nothing Then
MsgBox "Sheet " & Sht & " does not exist"
Exit Sub
End If
With ActiveSheet
.Range("B5:E" & .Cells(Rows.Count, 2).End(xlUp).Row).Copy
End With
Ws.Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Sub
[/code]

 

[rlv01]

It might be easier just to recreate the formulas at the end after each copy

Sub Copy_data_3()
    Dim Ws As Worksheet
    Dim Sht As String
    Dim LASTROW As Long


    Sht = InputBox("Please enter sheet name")
    On Error Resume Next
    Set Ws = Workbooks("2018_CONTABILIDAD TOTAL.xlsm").Sheets(Sht)
    On Error GoTo 0
    If Ws Is Nothing Then
        MsgBox "Sheet " & Sht & " does not exist"
        Exit Sub
    End If
    With ActiveSheet
        .Range("B5:E" & .Cells(Rows.count, 2).End(xlUp).Row).Copy
    End With


    With Ws.Range("G" & Rows.count).End(xlUp)
        .Offset(0, 0).PasteSpecial xlPasteValues
        .Offset(1, 0).Formula = "=SUM(G1:" & .Address(False, False) & ")"
        .Offset(1, 0).Copy .Offset(1, 1).Resize(, 3)
    End With
End Sub

 

[Robert Germain]

Hi riv01. Thank you for this. I am running this and I get a VB stoppage after entering the sheet name. I thought that maybe it is because it is because of the "=SUM(G1:" where I changed this to indicate where the actual Total line is in the sheet but this didn't help. I am not very familiar with VB coding so please bear with me on this.

It might be easier just to recreate the formulas at the end after each copy

Sub Copy_data_3()
    Dim Ws As Worksheet
    Dim Sht As String
    Dim LASTROW As Long


    Sht = InputBox("Please enter sheet name")
    On Error Resume Next
    Set Ws = Workbooks("2018_CONTABILIDAD TOTAL.xlsm").Sheets(Sht)
    On Error GoTo 0
    If Ws Is Nothing Then
        MsgBox "Sheet " & Sht & " does not exist"
        Exit Sub
    End If
    With ActiveSheet
        .Range("B5:E" & .Cells(Rows.count, 2).End(xlUp).Row).Copy
    End With


    With Ws.Range("G" & Rows.count).End(xlUp)
        .Offset(0, 0).PasteSpecial xlPasteValues
        .Offset(1, 0).Formula = "=SUM(G1:" & .Address(False, False) & ")"
        .Offset(1, 0).Copy .Offset(1, 1).Resize(, 3)
    End With
End Sub

 

[rlv01]

See if this works.

Sub Copy_data_4()
    Dim Ws As Worksheet
    Dim Sht As String
    Dim LASTROW As Long
    Dim WB As Workbook
    Dim FPath As String, FName As String

    FPath = ""    ' If needed.  Example: "C:\Users\RobertGermain\Documents\"
    FName = "Performance Template (Final).xlsx"

    'Is the workbook already open?
    For Each WB In Application.Workbooks
        If WB.Name = FName Then
            Exit For
        End If
        Set WB = Nothing
    Next WB

    'If no, then open it
    If WB Is Nothing Then
        On Error Resume Next
        Set WB = Workbooks.Open(FPath & FName)
        On Error GoTo 0
    End If

    If WB Is Nothing Then
        MsgBox "Cannot find Workbook" & vbCr & vbCr & FPath & FName
        Exit Sub
    End If

    Sht = InputBox("Please enter sheet name")
    On Error Resume Next
    Set Ws = WB.Worksheets(Sht)
    On Error GoTo 0
    If Ws Is Nothing Then
        MsgBox "Sheet " & Sht & " does not exist"
        Exit Sub
    End If
    With ActiveSheet
        .Range("B5:E" & .Cells(Rows.count, 2).End(xlUp).Row).Copy
    End With

    With Ws.Range("G" & Rows.count).End(xlUp)
        .Offset(0, 0).PasteSpecial xlPasteValues
        .Offset(1, 0).Formula = "=SUM(G1:" & .Address(False, False) & ")"
        .Offset(1, 0).Copy .Offset(1, 1).Resize(, 3)
    End With
End Sub

 

[Robert Germain]

Hey rlv01

This is even better! I like the fact that you have added a validation and/or automatic opening of the file for the data to be copied to. Much appreciated. I've adjusted the code to reflect my reality. Works except that it copies to the first cell after my total line in column G.

Notice that I have taken out these two lines because I get a compilation error of invalid or unqualified reference -
.Offset(1, 0).Formula = "=SUM(G1:" & .Address(False, False) & ")"
.Offset(1, 0).Copy .Offset(1, 1).Resize(, 3)

Here is the code I have modified:

Sub Copy_data_4()

   Dim Ws As Worksheet
   Dim Sht As String
   Dim LASTROW As Long
   Dim WB As Workbook
   Dim FPath As String, FName As String
   FPath = "C:\Users\Robert Germain\Desktop\RG2_Solutions\TecnoCom\TecnoCom Accounting\2018 TecnoCom Accounting\"
   FName = "2018_CONTABILIDAD TOTAL_2.xlsm"
   
   'Is the workbook already open?
   For Each WB In Application.Workbooks
        If WB.Name = FName Then
            Exit For
        End If
        Set WB = Nothing
   Next WB
   
   'If no, then open it
   If WB Is Nothing Then
        On Error Resume Next
        Set WB = Workbooks.Open(FPath & FName)
        On Error GoTo 0
   End If

   If WB Is Nothing Then
        MsgBox "Cannot find Workbook" & vbCr & vbCr & FPath & FName
        Exit Sub
   End If
   
   Sht = InputBox("Please enter sheet name")
   On Error Resume Next
   Set Ws = Workbooks("2018_CONTABILIDAD TOTAL_2.xlsm").Sheets(Sht)
   On Error GoTo 0
   If Ws Is Nothing Then
      MsgBox "Sheet " & Sht & " does not exist"
      Exit Sub
   End If
   With ActiveSheet
      .Range("B5:E" & .Cells(Rows.Count, 2).End(xlUp).Row).Copy
   End With
   Ws.Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Sub

 

[rlv01]

It seems to me that by reverting to your original code using .Offset(1, 0) to paste the data

Ws.Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

You are reverting to your original problem of how to deal with the last non-empty line being a "totals" line that should not be part of the data set

And by removing

.Offset(1, 0).Formula = "=SUM(G1:" & .Address(False, False) & ")" '<-- this line adds a summation formula for range G1:Gn to the first cell of the new "total" row
.Offset(1, 0).Copy .Offset(1, 1).Resize(, 3) '<-- this line copies the formula to the other cells in the new totals row.

You have elimitated the part of the code that would have recreated a new "totals" line.

 

[Robert Germain]

rlv01,

I have taken out these two lines because I get a compilation error of invalid or unqualified reference at this line-
.Offset(1, 0).Formula = "=SUM(G1:" & .Address(False, False) & ")"

 

[rlv01]

Keep mind that what I'm posting are coding examples. They run for me, but I have not seen your workbook and so it's possible, likely even, that you will need to adjust the example to adapt to differences your workbook that I am not aware of. Compiler errors provide you with the clues that will help you make those adjustments.

For example, if you are trying to sum each column, in G thru S, but you are using row 1 for column labels instead of data you might have to adjust the example to account for that header row.

[COLOR=#333333].Offset(1, 0).Formula = "=SUM([/COLOR][COLOR=#0000ff][B]G2[/B][/COLOR][COLOR=#333333]:" & .Address(False, False) & ")"[/COLOR]

 

[Robert Germain]

rlv01

Sent you a private email, if that is ok with you.