Makro Aufzeichnung mit Schleife!

  • Sonstige

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von Pascal.

    Makro Aufzeichnung mit Schleife!

    Tach auch,

    hab mir in Excel ein Makro aufgezeichnet, was wie folgt aussieht:

    ----------------------------------------------------------------------------
    Sub Datenselektion()
    '
    ' Datenselektion Makro
    ' Makro am 15.08.2006 von Benutzerservice aufgezeichnet
    '
    ' Tastenkombination: Strg+Umschalt+M
    '
    Cells.FindNext(After:=ActiveCell).Activate
    Selection.Copy
    Windows("Mappe3").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("ses31.txt").Activate
    Cells.Find(What:="KB", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
    .Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Mappe3").Activate
    Range("B1").Select
    ActiveSheet.Paste
    Windows("ses31.txt").Activate
    End Sub
    -----------------------------------------------------------------------------

    also ich suche nach einem ' kopiere das in Mappe3, suche dann nach KB und kopiere das auch in Mappe3. Das ist die Aufgabe des Skriptes! Nun habe ich aber noch nie VBA programmiert, also probierte ich einfach mal folgendes:

    ich muss diesen Vorgang ja solange wiederholen bis ich ganz unten im text bin, also habe ich oben ein Do
    und unten über End Sub Loop While Cells.Find <> "'Ende'" eingefügt! (denn ganz unten im Text habe ich 'Ende' stehen! so da das ja nur geraten war fkt das natürlich nicht......

    wie muss ich denn jetzt in VBA eine Abbruchbedingung formulieren, denn ich kann ja auch kein EOF verwenden usw....

    Visual Basic-Quellcode

    1. Dim objRange As Range
    2. Dim objCell As Range
    3. Dim objWS as WorkSheet
    5. Set objWS = ActiveWorkbook.Sheets("Tabelle1")
    6. Set objRange = objWS.Range(Zellbereich)
    8. If objWS Is Nothing Then Exit Sub
    9. If objRange Is Nothing Then Exit Sub
    11. Do
    13. Set objCell = objRange.Find(What:=[Suchbegriff], After:=ActiveCell, LookIn:= _
    14. xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    15. xlNext, MatchCase:=False, SearchFormat:=False)
    17. If objCell Is Nothing Then
    18. Exit Do
    19. Else
    20. 'sonst Code für das Kopieren in anderes Tabellenblatt einfügen
    21. End If
    23. Loop 'Until objCell Is Nothing

Facebook
Telefonspende