Macro to Insert a specified number of rows and columns

[Matt F]

I need help with a Macro to insert a specified number of rows in one worksheet and the same number but columns in another worksheet. I also need to mare sure the formulas are carried over.


The rows are inserting fine but I can't get the columns to work. Here is what I have so far:

Sub InsertRows_Columns()

Dim iRows As Long, rngStart As Range

On Error GoTo Canceled

iRows = InputBox("How many unit rows would you like to insert?", "Number of Rows", 5)

If iRows = 0 Then Exit Sub

With ActiveWorkbook.Worksheets("Sheet1")

Set rngStart = .Rows("10")

rngStart.Offset(1, 0).Resize(iRows, 1).EntireRow.Insert Shift:=xlDown

rngStart.EntireRow.Copy

rngStart.Offset(1, 0).Resize(iRows, 1).EntireRow.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With


With ActiveWorkbook.Worksheets("Sheet2")

Set rngStart = .Columns("I:I")

rngStart.Offset(1, 0).Resize(iRows, 1).EntireColumn.Insert Shift:=xlToRight

rngStart.EntireColumn.Copy

rngStart.Offset(1, 0).Resize(iRows, 1).EntireColumn.PasteSpecial xlPasteFormats

Application.CutCopyMode = False



End With

Canceled:
End Sub

 

[Deepak]

Try this!!!

Sub InsertRows_Columns()
Dim RCNum As Integer
Dim LastR As Integer
Dim LastC As Integer
Dim RWs As Worksheet
Dim CWs As Worksheet

On Error GoTo DoNoth:

RCNum = InputBox("How Many Rows and Columns to Insert?")

Set RWs = ThisWorkbook.Sheets("Sheet1")
Set CWs = ThisWorkbook.Sheets("sheet2")
LastR = RWs.Cells(Rows.Count, 1).End(xlUp).Row


RWs.Activate
Rows(LastR & ":" & LastR + RCNum - 1).Select
Selection.Insert Shift:=xlDown
CWs.Activate

With CWs
'Columns(LastC + 1, LastC - RCNum).Select
For i = 0 To RCNum - 1
LastC = CWs.Cells(2, Columns.Count).End(xlToLeft).Column
    .Columns(LastC - i).Insert
Next i
End With

RWs.Activate
Range("a1").Select

DoNoth:

End Sub

 

[Matt F]

Thanks this is now inserting the columns as well. The only thing missing are the formulas. Is there a small change we can add to the code that will copy the formulas over for each column that is inserted?

 

[Deepak]

Hope this will resolved the same!!!

Sub InsertRows_Columns()
Dim RCNum As Integer, LastR As Integer, LastC As Integer
Dim RWs As Worksheet, CWs As Worksheet
Dim r As Long

'On Error GoTo DoNoth:
RCNum = Application.InputBox("How Many Rows and Columns to Insert?")
    If RCNum = False Then GoTo DoNoth
Application.ScreenUpdating = False

Set RWs = ThisWorkbook.Sheets("Sheet1")
Set CWs = ThisWorkbook.Sheets("Sheet2")
LastR = RWs.Cells(Rows.Count, 1).End(xlUp).Row
r = [Table1].Rows.Count

With RWs
    For i = 0 To RCNum - 1
        Range("A" & r - 1 - i & ":C" & r - 1 - i).ListObject.ListRows.Add
    Next i
    Range("A" & r - 2 & ":C" & r - 2).AutoFill _
    Range("A" & r - 2 & ":C" & r + RCNum + 3)
End With

r = [Table3].Rows.Count

With CWs
     LastC = .Cells(2, Columns.Count).End(xlToLeft).Column
        For i = 0 To RCNum - 1
            .Columns(LastC - i).Insert
        Next i
            .Range(.Cells(2, LastC - 2), .Cells(r + 2, LastC - 2)).AutoFill Destination:= _
            .Range(.Cells(2, LastC - 2), .Cells(r + 2, RCNum + LastC - 1)), Type:=xlFillDefault
End With
DoNoth:
Application.ScreenUpdating = True
End Sub
End Sub