Adding Data links to the end of a table

[hattricktwenty]

This micro works but I want to insert the data into the Bottom of the table not the Top. Sub Complete_Post() sheet_name_to_create = Worksheets("New Customer").Range("C2") For rep = 1 To (Worksheets.Count) If Sheets(rep).Name = sheet_name_to_create Then MsgBox "This sheet already exists!" Exit Sub End If Next Sheets.Add After:=Worksheets("All Customers Info") ActiveSheet.Name = sheet_name_to_create Worksheets("New Customer").Range("A1:aa999").Copy ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAll ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats Range("Q5:W5").Copy Worksheets("All Customers Info").Select Range("a2").Select ActiveCell.EntireRow.Insert shift:=xlDown ActiveSheet.Paste link:=True End Sub

I tried this but it only gives a #REF in the first blank cell at the Bottom of thetable instead of links across the row. Sub Complete_Post() sheet_name_to_create = Worksheets("New Customer").Range("b2") For rep = 1 To (Worksheets.Count) If Sheets(rep).Name = sheet_name_to_create Then MsgBox "This sheet already exists!" Exit Sub End If Next Sheets.Add after:=Worksheets("All Customers Info") ActiveSheet.Name = sheet_name_to_create Worksheets("New Customer").Range("A1:aa999").Copy ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAll ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats Range("Q5:W5").Copy Worksheets("All Customers Info").Select ActiveSheet.ListObjects("Table1").ListRows.Add NextFree = Range("A11:a" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row Range("A" & NextFree).Select ActiveCell.EntireRow.Insert shift:=xlDown ActiveSheet.Paste link:=True End Sub

 

[johnnyL]

Since you said the code on the left functions, but it puts your pasted code at the top:

How about replacing the following code on the left side:

    Worksheets("All Customers Info").Select
    Range("a2").Select
    ActiveCell.EntireRow.Insert shift:=xlDown
    ActiveSheet.Paste link:=True
End Sub

With the following code:

    Worksheets("All Customers Info").Select
    LastRowInSheet = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row                      ' Returns Last Row Number
    Range("A" & LastRowInSheet + 1).Select
    ActiveSheet.Paste link:=True
End Sub

 

[hattricktwenty]

Since you said the code on the left functions, but it puts your pasted code at the top:

How about replacing the following code on the left side:

    Worksheets("All Customers Info").Select
    Range("a2").Select
    ActiveCell.EntireRow.Insert shift:=xlDown
    ActiveSheet.Paste link:=True
End Sub

With the following code:

    Worksheets("All Customers Info").Select
    LastRowInSheet = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row                      ' Returns Last Row Number
    Range("A" & LastRowInSheet + 1).Select
    ActiveSheet.Paste link:=True
End Sub

I tried the new code and it works but it puts the new line in as a total row. Now if I run the code after the first time it does not add it to the tale it adds it below.
Thank you some much for getting me closer to my goal!

 

[johnnyL]

Does this replacement do what you want?

    Worksheets("All Customers Info").Select
    LastRowInSheet = Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row                      ' Returns Last Row Number
    Range("A" & LastRowInSheet).Select
    ActiveCell.EntireRow.Insert shift:=xlDown
    ActiveSheet.Paste link:=True
End Sub

If not, perhaps you could provide an example of your starting data and what it should look like afterwards.