Snasui Excel Forum

Code: Select all

Sub Macro4()
  Dim number As Range

With Sheet1.Range("A:A")
Set number = .Range("B2")
Cells.Find(What:=Range("B1"), After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
     xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
     , SearchFormat:=False).Activate
     ActiveCell.EntireRow.Offset(1).Resize(number.Value).Insert Shift:=xlDown
End With
End Sub

Code: Select all

Dim number As Range
Dim endRow As Range
With Sheet1
Set number = .Range("B2")
    Set endRow = .Range("a:a").Find(what:=.Range("b1"), after:=.Range("a1"), _
        searchdirection:=xlPrevious)
'        Cells.Find(what:=Range("B1"), after:=Range("A1"), LookIn:=xlFormulas, LookAt:= _
         xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False _
         , SearchFormat:=False).Activate
         ActiveCell.EntireRow.Offset(1).Resize(number.Value).Insert Shift:=xlDown
End With

Code: Select all

Sub Macro4()
Dim number As Range
Dim endRow As Range
With Sheet1
Set number = .Range("B2")
    Set endRow = .Range("a:a").Find(what:=.Range("b1"), after:=.Range("a1"), _
        searchdirection:=xlPrevious)
         ActiveCell.EntireRow.Offset(1).Resize(number.Value).Insert Shift:=xlDown
End With
End Sub

Code: Select all

Dim rall As Range
Dim r As Range, i As Long
With Sheet1
    Set rall = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    For i = rall.Count To 1 Step -1
        If rall(i).Value = .Range("b1").Value Then
            rall(i).Offset(1, 0).Resize(.Range("b2").Value).Insert shift:=xlDown
            Exit For
        End If
    Next i
End With

Code: Select all

Sub Macro4()
Dim rall As Range
Dim r As Range, i As Long
On Error Resume Next
With Sheet1
    Set rall = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    For i = rall.Count To 1 Step -1
        If rall(i).Value = .Range("c1").Value Then
            rall(i).Offset(1, 0).Resize(.Range("c2").Value).Insert shift:=xlDown
            Exit For
        End If
    Next i
End With
End Sub

Code: Select all

Sub Macro4()
Dim rall As Range
Dim r As Range, i As Long
On Error Resume Next
With Sheet1
    Set rall = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    For i = rall.Count To 1 Step -1
        If rall(i).Value = .Range("c1").Value Then
            'rall(i).Offset(1, 0).Resize(.Range("c2").Value).Insert shift:=xlDown
            Rows(rall(i).Offset(1, 0).Row & ":" & ActiveCell.Row).Insert shift:=xlDown
            Exit For
        End If
    Next i
End With
End Sub