How to merge formatting in VBA after copying data from one spreadsheet to another? - excel

Question

I'm using this code to transfer invoice data in one sheet to invoice history in another sheet and it is working as intended. However, I cannot figure out how to transfer said data to the invoice history sheet without ruining the formatting of the table. The picture below shows what happens when the data is entered manually versus when the code is used (last three rows).
Dim xNew As Worksheet 'New Invoice Sheet
Dim xInvoices As Worksheet 'Invoice History Sheet
Dim iCurrentRow As Integer
Set xNew = ThisWorkbook.Sheets("New_Invoice")
Set xInvoices = ThisWorkbook.Sheets("Invoices")
iCurrentRow = xInvoices.Cells(xInvoices.Rows.Count, "B").End(xlUp).Row + 1
With xInvoices
.Cells(iCurrentRow, 2) = xNew.Range("F5")
.Cells(iCurrentRow, 3) = xNew.Range("B9")
.Cells(iCurrentRow, 4) = xNew.Range("Total")
.Cells(iCurrentRow, 5) = "Not Paid"
.Cells(iCurrentRow, 6) = "Outright"
.Cells(iCurrentRow, 7) = Date + 1
End With

Answer 1

You did not answered the clarification question, but if there is a real ListObject in the sheet you try pasting below its last row, please try the next code:
Sub testLstRTable()
Dim xNew As Worksheet, xInvoices As Worksheet, firstR As Long, lastR As Long, tb As ListObject
Set xNew = ThisWorkbook.Sheets("New_Invoice")
Set xInvoices = ThisWorkbook.Sheets("Invoices")
Set tb = xInvoices.ListObjects("YourTable") 'use here your real table name!!!
firstR = tb.HeaderRowRange.row 'for the case when the table header row is not the first...
lastR = tb.ListRows.count + firstR
xInvoices.Range(xInvoices.cells(lastR + 1, 2), xInvoices.cells(lastR + 1, 7)).value = _
Array(xNew.Range("F5").value, xNew.Range("B9").value, xNew.Range("Total").value, "Not Paid", "Outright", Date + 1)
End Sub
Please, pay attention to changing the Table name, using the one existing in the involved sheet.
But if you name a simple formatted range as a table, please use the next code variant:
Sub testKeepFormat()
Dim xNew As Worksheet, xInvoices As Worksheet, lastR As Long
Set xNew = ThisWorkbook.Sheets("New_Invoice")
Set xInvoices = ThisWorkbook.Sheets("Invoices")
lastR = xInvoices.Range("B" & xNew.rows.count).End(xlUp).row
With xInvoices.Range(xInvoices.cells(lastR + 1, 2), xInvoices.cells(lastR + 1, 7))
.value = Array(xNew.Range("F5").value, xNew.Range("B9").value, xNew.Range("Total").value, "Not Paid", "Outright", Date + 1)
.Interior.Color = .Offset(-2).Interior.Color
.cells(1, 2).HorizontalAlignment = .Offset(-2).cells(1, 2).HorizontalAlignment
End With
End Sub

Answer 2

Copy Row Data Using Insert
This will use the formatting of the last row.
Option Explicit
Sub RecordNewInvoice()
Const sName As String = "NewInvoice"
Const dName As String = "Invoices"
Const dCol As String = "B"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim RowData As Variant: RowData = GetRowData(sws)
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dCell As Range: Set dCell = dws.Cells(dws.Rows.Count, dCol).End(xlUp)
dCell.Offset(1).EntireRow.Insert
dCell.Offset(1).Resize(, UBound(RowData)).Value = RowData
End Sub
Function GetRowData( _
sws As Worksheet) _
As Variant
Dim RowData(1 To 6) As Variant
RowData(1) = sws.Range("F5").Value
RowData(2) = sws.Range("B9").Value
RowData(3) = sws.Range("Total").Value
RowData(4) = "Not Paid"
RowData(5) = "Outright"
RowData(6) = Date + 1
GetRowData = RowData
End Function