Schleife einfügen?

Hallo zusammen,
habe ein Makro aufgezeichnet, bei welchem in Spalte F nach einer nicht leeren Zelle gesucht werden soll. Wird eine nicht leere Zelle gefunden, sollen bestimmt Schritte ausgeführt werden. Danach soll in Spalte F nach dem nächsten nichtleeren Feld gesucht werden, die gleichen Schritte ausgeführt werden.... und immer so weiter, so lange, bis in Spalte F nur noch leere Felder übrig sind. Dann soll das Ganze beendet werden.
Ich habe gegoogelt und weiss jetzt, dass man das mit einer Schleife lösen könnte. Also quasi If "Leere Zelle", dann "Diverse Schritte" sonst "Stop". Das habe ich auch selbst schon probiert, aber leider ohne Erfolg. Kann mir jemand helfen?
Hier mein Makro:
Columns("F:F").Select
Selection.Find(What:="*").Activate
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
ActiveSheet.Name = Range("F2").Value
Range("A1").Select
Sheets("Start").Select
Range("M7").Select
Application.CutCopyMode = False
Selection.Copy
Rows("2:2").Select
Application.CutCopyMode = False
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Schon mal danke für jegliche Hilfe.
Viele Grüße Nicole

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Find_Methode() Dim RaZelle As Range Dim StFundst As String Dim LoLetzte As Long LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _ Count) Set RaZelle = Range("A1:A" & Rows.Count).Find("", , , xlPart, , xlNext) If Not RaZelle Is Nothing Then StFundst = RaZelle.Address Do MsgBox RaZelle.Address ' deine Aktionen mit rZelle.Offset(0,1) Set RaZelle = Range("A1:A" & Rows.Count).FindNext(RaZelle) If RaZelle.Row > LoLetzte Then Exit Do Loop While Not RaZelle Is Nothing And RaZelle.Address StFundst End If End Sub

Hallo Hajo,
vielen Dank für deine Hilfe. Leider klappt es noch nicht so ganz. Das Makro sieht nun so aus:

Public Sub Find_Methode()
Dim RaZelle        As Range
Dim StFundst       As String
Dim LoLetzte As Long
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Set RaZelle = Range("A1:A" & Rows.Count).Find("", , , xlPart, , xlNext)
If Not RaZelle Is Nothing Then
StFundst = RaZelle.Address
Do
MsgBox RaZelle.Address
rZelle.Offset(0, -1).Range("A1").Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
ActiveSheet.Name = Range("F2").Value
Range("A1").Select
Sheets("Start").Select
Range("M7").Select
Application.CutCopyMode = False
Selection.Copy
Rows("2:2").Select
Application.CutCopyMode = False
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Set RaZelle = Range("A1:A" & Rows.Count).FindNext(RaZelle)
If RaZelle.Row > LoLetzte Then Exit Do
Loop While Not RaZelle Is Nothing And RaZelle.Address  StFundst
End If
End Sub

Hoffe, ich habe meinen Befehl an der richtigen Stelle eingesetzt.
Bei MsgBox RaZelle.Address
kommt immer einen Box, mit der Information $a$1, die ich mit OK wegdrücken muss. Danach Laufzeitfehler 242:-)
Kann man auf eine solche Box nicht verzichten? Eigentlich wäre es mir am liebsten, wenn ich das Makro anstoße, und es bis zum Ende durchläuft, ohne, dass ich etwas machen muss.
LG
Nicole

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread