Thema: Zahl suchen und an den Fundstellen Zeile einfügen

StandardModule: Modul1

Sub FindenEinfuegen()
   Dim wks As Worksheet
   Dim rng As Range
   Dim dInput As Double
   Dim sRng As String
   dInput = Application.InputBox( _
      prompt:="Geben Sie eine Zahl ein:", _
      Title:="Zahleneingabe", _
      Default:="7", _
      Type:=1)
   For Each wks In Worksheets
      If wks.Index > 1 Then
         Set rng = wks.Cells.Find( _
            what:=dInput, _
            lookat:=xlWhole, _
            LookIn:=xlValues)
         If Not rng Is Nothing Then
            sRng = rng.Address
            rng.Offset(1, 0).EntireRow.Insert
            Do
               Set rng = wks.Cells.FindNext(rng)
               If rng.Address <> sRng Then
                  rng.Offset(1, 0).EntireRow.Insert
               Else
                  Exit Do
               End If
            Loop
         End If
      End If
   Next wks
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Suchen