Tables not automatically grabbing when new data is automatically paste below table

matrix

New member
Joined
Dec 21, 2019
Messages
28
Reaction score
0
Points
1
Location
Usa
Excel Version(s)
2019
Hello Excel World. Below I have a code that copies different cells data and transfers and paste data from one worksheet into multiple worksheets base on the cells reference names.

My problem here is this. Each worksheets have tables that (SHOULD GRAB) the new data that is paste automatically below the table, which overtime it creates an historical data and automatically update the column chart for each table.

How can I make adjustments to the code below that supports my request?

Thanks in advance

Cheers

Code:
[COLOR=#0000FF][FONT=inherit]Sub[/FONT][/COLOR][COLOR=#141414][FONT=inherit] Update_Sheets[/FONT][/COLOR][COLOR=#141414][FONT=inherit]([/FONT][/COLOR][COLOR=#141414][FONT=inherit])[/FONT][/COLOR]
  [COLOR=#0000FF]Dim[/COLOR] sh1 [COLOR=#0000FF]As[/COLOR] Worksheet, sh2 [COLOR=#0000FF]As[/COLOR] Worksheet
  [COLOR=#0000FF]Dim[/COLOR] i [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long[/COLOR], j [COLOR=#0000FF]As[/COLOR] [COLOR=#0000FF]Long[/COLOR], f [COLOR=#0000FF]As[/COLOR] Range
  
  [COLOR=#0000FF]Set[/COLOR] sh1 = Sheets([COLOR=#E29232]"Debt_to_GDP"[/COLOR])
  [COLOR=#0000FF]For[/COLOR] i = [COLOR=#C92C2C]2[/COLOR] [COLOR=#0000FF]To[/COLOR] sh1.Range([COLOR=#E29232]"A:A"[/COLOR]).Find([COLOR=#E29232]"*"[/COLOR], , xlValues, , xlByRows, xlPrevious).Row
    [COLOR=#0000FF]Set[/COLOR] sh2 = Sheets(Replace(sh1.Range([COLOR=#E29232]"A"[/COLOR] & i).Value, [COLOR=#E29232]" "[/COLOR], [COLOR=#E29232]"_"[/COLOR]))
    [COLOR=#0000FF]Set[/COLOR] f = sh2.Range([COLOR=#E29232]"B:B"[/COLOR]).Find(sh1.Range([COLOR=#E29232]"B"[/COLOR] & i).Value, , xlFormulas, xlWhole)
    [COLOR=#0000FF]If[/COLOR] f [COLOR=#0000FF]Is[/COLOR] [COLOR=#C92C2C]Nothing[/COLOR] [COLOR=#0000FF]Then[/COLOR]
      j = sh2.Range([COLOR=#E29232]"B:B"[/COLOR]).Find([COLOR=#E29232]"*"[/COLOR], , xlValues, , xlByRows, xlPrevious).Row + [COLOR=#C92C2C]1[/COLOR]
      sh2.Range([COLOR=#E29232]"B"[/COLOR] & j).Value = sh1.Range([COLOR=#E29232]"B"[/COLOR] & i).Value
      sh2.Range([COLOR=#E29232]"C"[/COLOR] & j).Value = sh1.Range([COLOR=#E29232]"C"[/COLOR] & i).Value
    [COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]If[/COLOR]
  [COLOR=#0000FF]Next[/COLOR] [COLOR=#0000FF][FONT=inherit]End[/FONT][/COLOR][COLOR=#0000FF][FONT=inherit]Sub[/FONT][/COLOR]



 
hope this helps

This should re-calculate your sheet.

Note: Place this under ThisWorkBook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
With ActiveSheet
.EnableCalculation = False
.EnableCalculation = True
.Calculate
End With
End Sub
 
Last edited:
Last edited:
You could try adding a row to the table before pasting. This should work if you only have a single table on your destination sheets.

Code:
[COLOR=#0000FF]If[/COLOR] f [COLOR=#0000FF]Is[/COLOR] [COLOR=#C92C2C]Nothing[/COLOR] [COLOR=#0000FF]Then[/COLOR][INDENT]j = sh2.Range([COLOR=#E29232]"B:B"[/COLOR]).Find([COLOR=#E29232]"*"[/COLOR], , xlValues, , xlByRows, xlPrevious).Row + [COLOR=#C92C2C]1
' add row to table
[/COLOR][/INDENT]
[INDENT]sh2.Listobjects(1).Listrows.Add[/INDENT]
[INDENT]sh2.Range([COLOR=#E29232]"B"[/COLOR] & j).Value = sh1.Range([COLOR=#E29232]"B"[/COLOR] & i).Value[/INDENT]
[INDENT]sh2.Range([COLOR=#E29232]"C"[/COLOR] & j).Value = sh1.Range([COLOR=#E29232]"C"[/COLOR] & i).Value[COLOR=#0000FF]
[/COLOR][/INDENT]
[COLOR=#0000FF]End[/COLOR] [COLOR=#0000FF]If[/COLOR][INDENT]
[/INDENT]
 
Ok. Thanks would try and get back with you. I have over 80 worksheets to work with...
 
I am sorry NormS. I am getting an error. I am not sure what to do going forward...
 
That's funny. I downloaded your file, made the change and it worked for me. I only tried the first few sheets, though (using For i = 2 to 5). What sort of error do you get?
 
Thank you for your reply. I am not sure if I have done any thing wrong. However, I have two images that show what I have done.

However, I Worksheet "Algeria" in row number 22 the table is not fulfilling.

What do you suggest me to do?

Thanks again


Cheers




Capture.PNGSnap.PNG
 
Thank you NormS. It works, it works. I really appreciate it a lot.

Thanks Today,Today, 01:00 AM#9

 
Back
Top