How to insert rows in sheet1 based on sequence number.

**aleanboy** · 10-14-2014, 05:30 AM

Hi,

How do I insert few rows in sheet 1 based on sequence number provided in sheet called “Sequence number”
Example: In sheet 1, after sequence number 8 one row has to be inserted, similarly,
After sequence number 11, two rows has to be inserted, similarly,
After sequence number 18, one row has to be inserted and so on…..
Please provide a VBA code for the same.

Thank you in advance..

Private Sub CommandButton1_Click()
Dim PvtTbl As PivotTable
Dim PvtTblCache As PivotCache
Dim ws As Worksheet, wsPvtTbl As Worksheet
Dim rng As Range, Pvtrng As Range, Pvtcell As Range, Mrng As Range
Dim lr As Long, Pvtlr As Long
Application.ScreenUpdating = False
Set ws = Sheets("Sheet3")
lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = ws.Range("A1:E" & lr)
Set wsPvtTbl = Sheets("Sheet1")
'wsPvtTbl.Cells.Clear
For Each PvtTbl In wsPvtTbl.PivotTables
    'PvtTbl.TableRange2.Clear
Next PvtTbl
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rng, _
Version:=xlPivotTableVersion12).CreatePivotTable tabledestination:=wsPvtTbl.Range("D6"), _
TableName:="PivotTable1", defaultversion:=xlPivotTableVersion12
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")
wsPvtTbl.Select
    With PvtTbl.PivotFields("Invoiced By")
        .Orientation = xlRowField
        .Position = 1
        .Subtotals(1) = False
    End With
    
    With PvtTbl.PivotFields("Gross Profit")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With
    With PvtTbl.PivotFields("Gross Profit")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 2
    End With
    
    With PvtTbl.PivotFields("MTD Gross")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 3
    End With
    
        With PvtTbl
        .RowAxisLayout xlTabularRow
    End With
Pvtlr = wsPvtTbl.Cells(Rows.Count, 1).End(xlUp).Row
With Range("D7:G7")
    .Interior.ColorIndex = 1
    .Font.ColorIndex = 2
    .Font.Size = 12
    .Font.Bold = True
End With
'With Range("D" & Pvtlr & ":D" & Pvtlr)
 '   .Interior.ColorIndex = 2
  '  .Font.ColorIndex = 2
'End With
wsPvtTbl.Columns.AutoFit
Range("D1").Select
Application.ScreenUpdating = True
    With ActiveSheet.UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    
    Rows(5).Delete
    
    Application.CutCopyMode = False
MsgBox "Report has been created successfully."
Cells(6, 8) = "Sequence"

Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
'What are the names of our worksheets?
Set sourceSheet = Worksheets("Sequence Number")
Set outputSheet = Worksheets("Sheet1")
'Determine last row of source
With sourceSheet
     SourceLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With
With outputSheet
     'Determine last row in col P
    OutputLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
     'Apply our formula
     
     
      .Range("H7:H" & OutputLastRow).Formula = _
         "=IFERROR(VLOOKUP(D7,'" & sourceSheet.Name & "'!$D$2:$E$" & SourceLastRow & ",2,0),""0"")"
         
         
End With
Range("H7:H" & OutputLastRow).Value = Range("H7:H" & OutputLastRow).Value

 Worksheets("Sheet1").Range("D6:H65530").Sort _
 Key1:=Worksheets("Sheet1").Range("H6"), Header:=xlYes
 Rows(5).Clear
 Rows(7).Delete
End Sub