Inserting new rows to a table then pasting a range into the new rows

orangebloss

New Member
Joined
Jun 5, 2013
Messages
43
I'm trying to add rows to a table and then copy the data into it. I had perfected the art of copy the data into the spreadsheet but as I have graphs etc running off the table I lose all the data in my charts - is there an easy way to add rows and then paste into the rows I've just added?
I can add the rows but then it doesn't paste the data in. - all code is below:

Initial VBA that runs through the list of values to be copied:
VBA Code:
Sub CreateSandbox()
       Dim rngData As Range, cell As Range
       Dim RoughCut As Worksheet, ProjectList As Worksheet
      Dim Sandbox As Worksheet
       Set RoughCut = Worksheets("Rough Cut")
       Set ProjectList = Worksheets("Project Data (G)")
       Set Sandbox = Worksheets("Sandbox")
      
' Clear the existing table
 Sandbox.ListObjects("Table2").Range.AutoFilter Field:=3
   
    Sandbox.Rows("27:27").Select
    Sandbox.Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp

      
       'size range data in Project list
       With ProjectList
        Set rngData = .Range(.Range("A4"), .Range("A" & .Rows.Count).End(xlUp))
       End With
    
      ' Establish "For" loop.
      For Each cell In rngData.Cells
         If cell.Value = "Yes" Then
            'If the value in the first cell of the row is Yes then
            'paste the value into the Rough Cut worksheet in cell V4
            RoughCut.Range("V2").Value = cell.Offset(0, 1).Value
           
           
         
          Call UpdateSandbox
          Else
          End If
      Next cell

   End Sub

This code copies the data across to the table
VBA Code:
Sub UpdateSandbox()
 Application.ScreenUpdating = False
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet
 Set copySheet = Worksheets("Rough Cut")
  Set pasteSheet = Worksheets("Sandbox")
  Set Destination = pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(13, 0) ' I've inserted 13 rows so logic says to paste in 13 rows before the first empty cell
  Set WksPlanned = Destination.Offset(0, 9)
  Set Totals = Destination.Offset(12, 18)
  
 

Application.CutCopyMode = False
 Call insertrows
  
  copySheet.Range("C27:DY39").Copy
  
Destination.PasteSpecial Paste:=xlPasteFormats
   
  Destination.PasteSpecial Paste:=xlPasteValues
  copySheet.Range("L27:R39").Copy
  WksPlanned.PasteSpecial Paste:=xlPasteFormulas
  WksPlanned.PasteSpecial Paste:=xlPasteFormats
  copySheet.Range("U39:DY39").Copy
  Totals.PasteSpecial Paste:=xlPasteFormulas
  pasteSheet.Cells.RowHeight = 11.25
   pasteSheet.Rows("7:18").EntireRow.Hidden = True
   pasteSheet.Rows("1:2").EntireRow.Hidden = True
   pasteSheet.Activate

  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  
End Sub

This code inserts the rows into the table
VBA Code:
Sub insertrows()
 'Declare Variables
    Dim oSheetName As Worksheet
    Dim sTableName As String
    Dim loTable As ListObject
    Dim iCnt As Integer
    
    'Define Variable
    sTableName = "Table2"
    
    'Define WorkSheet object
    Set oSheetName = Sheets("Sandbox")
    
    'Define Table Object
    Set loTable = oSheetName.ListObjects(sTableName)
    
    For iCnt = 1 To 13 'You can change based on your requirement
        'Add multiple rows to the table
        loTable.ListRows.Add
    Next
End Sub
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Watch MrExcel Video

Forum statistics

Threads
1,127,191
Messages
5,623,287
Members
415,963
Latest member
PatrickDurning

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
Top