VBA Code not pasting to top row of Table

WxShady13

Board Regular
Joined
Jul 24, 2018
Messages
184
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
I have VBA code that will pull the last row of data from a table on every worksheet within the workbook and then paste it back to the Balance Tables worksheet. Currently it is not pasting to the 1st row of the table (each month I need to overwrite the data for billing purposes). What adjustments need to be made to the code to get it to start at the first row of the table?
VBA Code:
Sub Copy_Sheets_To_Master()

Dim wb As Workbook
Dim ws As Worksheet
Dim i, LastRowa, LastRowd As Long
Dim WSname As String

Set wb = ActiveWorkbook

For Each ws In wb.Sheets

If ws.Name <> "Balance Tables" Then
'If ws.Name <> "Monthly Amount Due" Then
If ws.Name <> "Main" Then
If ws.Name <> "Key" Then
If ws.Name <> "Mail Merge" Then
'If ws.Name <> "Balance" Then
'If ws.Name <> "VLOOKUP DATA" Then
'If ws.Name <> "Payroll Table" Then
'If ws.Name <> "Payment Log" Then

WSname = ws.Name

'With ActiveSheet
ws.Cells(Rows.Count, 1).End(xlUp).EntireRow.Copy
'End With
'LastRowa = ws.Cells(Rows.Count, "A").End(xlUp).Row
LastRowd = Sheets("Balance Tables").Cells(Rows.Count, "A").End(xlUp).Row

'ws.Range("A6" & LastRowa).EntireRow.Copy
Sheets("Balance Tables").Range("A" & LastRowd + 1).PasteSpecial Paste:=xlPasteValues
'Sheets("Master").Range("A" & LastRowd + 1).Value = WSname

End If
End If
End If
End If
'End If
'End If
'End If
'End If
'End If

Next ws

End Sub
 
Looks like you have data below the table.
What's the name of the table? Say it's "Table1", then
Replace these 2 lines:

LastRowd = Sheets("Balance Tables").Cells(Rows.Count, "A").End(xlUp).Row Sheets("Balance Tables").Range("A" & LastRowd + 1).PasteSpecial Paste:=xlPasteValues

with this:
Sheets("Balance Tables").ListObjects("Table1").DataBodyRange.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
That just posted the last line from the last worksheet.
 
Upvote 0

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
That just posted the last line from the last worksheet.
I don't understand what you mean.
What's the name of the table?
 
Upvote 0
VBA Code:
iRow=iRow+1
Sheets("Balance Tables").ListObjects("Table1").DataBodyRange.Cells(iRow, 1).PasteSpecial Paste:=xlPasteValues
 
Upvote 0
I think not.
You use column A to check for the last filled cell: LastRowd = Sheets("Balance Tables").Cells(Rows.Count, "A").End(xlUp).Row
Because you copy/paste a total row all the formulas will disappear.
You must check all the cells in column A. With CTRL + Arrow keys you can jump to empty cells.
 
Upvote 0
to get the sheet row number of the first table row try this

VBA Code:
Dim SheetRowOfFirstTableRow As Long

SheetRowOfFirstTableRow = Sheets("Balance Tables").ListObjects("BalanceTable").HeaderRowRange.Row + 1
 
Upvote 0
I think not.
You use column A to check for the last filled cell: LastRowd = Sheets("Balance Tables").Cells(Rows.Count, "A").End(xlUp).Row
Because you copy/paste a total row all the formulas will disappear.
You must check all the cells in column A. With CTRL + Arrow keys you can jump to empty cells.
So your code adjustment works perfectly but yes it wipes out the formulas. I am going to add the VBA code at the end to input the formulas back in the 1st row.
 
Upvote 0
You can copy only the cells without formulas.
VBA Code:
LastRowWS = ws.Cells(Rows.Count, "A").End(xlUp).Row
iRow=iRow+1
ws.Range("A"&LastRowWS&":D"&LastRowWS.Copy  Destination:=Sheets("Balance Tables").ListObjects("BalanceTable").DataBodyRange.Cells(iRow, 1)
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,291
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top