Optimieren von Excel-Makros

[TerenceSkill]

Hallo Habo-Board,

ich befasse mich ein wenig mit Excel zur Zeit und möchte folgendes Umsetzen:

Klicke auf Button1 und er prüft, was die erste freie Zeile in Spalte A oder Spalte B ist und fügt dann in das betreffende Feld einen Wert ein im Beispiel "Auto1".

Button2 macht das selbe nur mit dem Wert "Auto2".

Mein Problem bzw. Frage ist, ist es möglich VB-Script so anzupassen, dass es automatisch so lange in die nächste Zeile geht bis eine Frei ist?

Momentan würde es nach meinen Prinzip bedeuten, dass ich für jeden Button jede Zeile angeben müsste:

Spoiler: Code

Private Sub CommandButton1_Click()

    If Range("A17") = "" Then
       Range("A17").Select
       ActiveCell.FormulaR1C1 = "Auto1"
       Range("C17") = Time

    Else
    
    If Range("B17") = "" Then
       Range("B17").Select
       ActiveCell.FormulaR1C1 = "Auto1"
       Range("D17").Select
    Else
    
    If Range("A18") = "" Then
       Range("A18").Select
       ActiveCell.FormulaR1C1 = "Auto1"
       Range("C18") = Time
      
    Else
    
    If Range("B18") = "" Then
       Range("B18").Select
       ActiveCell.FormulaR1C1 = "Auto1"
       Range("D18").Select
    Else
     
    If Range("A19") = "" Then
       Range("A19").Select
       ActiveCell.FormulaR1C1 = "Auto1"
       Range("C19") = Time
      
    Else
    
    If Range("B19") = "" Then
       Range("B19").Select
       ActiveCell.FormulaR1C1 = "Auto1"
       Range("D19").Select
        
    End If
    End If
    End If
    End If
    End If
    End If
    
End Sub

Private Sub CommandButton2_Click()
    If Range("A17") = "" Then
       Range("A17").Select
       ActiveCell.FormulaR1C1 = "Auto2"
       Range("C17") = Time

    Else
    
    If Range("B17") = "" Then
       Range("B17").Select
       ActiveCell.FormulaR1C1 = "Auto2"
       Range("D17").Select
    Else
    
    If Range("A18") = "" Then
       Range("A18").Select
       ActiveCell.FormulaR1C1 = "Auto2"
       Range("C18") = Time
      
    Else
    
    If Range("B18") = "" Then
       Range("B18").Select
       ActiveCell.FormulaR1C1 = "Auto2"
       Range("D18").Select
    Else
     
    If Range("A19") = "" Then
       Range("A19").Select
       ActiveCell.FormulaR1C1 = "Auto2"
       Range("C19") = Time
      
    Else
    
    If Range("B19") = "" Then
       Range("B19").Select
       ActiveCell.FormulaR1C1 = "Auto2"
       Range("D19").Select
        
    End If
    End If
    End If
    End If
    End If
    End If
    
End Sub

Der dritte Button, soll prüfen, in welcher Zeile der letzte Eintrag ist und in die nächste Zeile folgende Werte schreiben: Wert aus vorheriger Spalte A in Spalte B und umgekehrt. Funktioniert auch, nur da müsste ich auch für alle Zeilen eine extra Schleife einfügen...:

Spoiler: Code

Private Sub CommandButton3_Click()


    If Range("A18") = "" Then
        Range("A17").Select
        Selection.Copy
        Range("B18").Select
        ActiveSheet.Paste
        Range("B17").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("A18").Select
        ActiveSheet.Paste
        Range("C18") = Time
        Range("D18").Select
    Else
    
    If Range("A19") = "" Then
        Range("A18").Select
        Selection.Copy
        Range("B19").Select
        ActiveSheet.Paste
        Range("B18").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("A19").Select
        ActiveSheet.Paste
        Range("C19") = Time
        Range("D19").Select
    Else
    
    If Range("A20") = "" Then
        Range("A19").Select
        Selection.Copy
        Range("B20").Select
        ActiveSheet.Paste
        Range("B19").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("A20").Select
        ActiveSheet.Paste
        Range("C20") = Time
        Range("D20").Select
    Else
    
    If Range("A21") = "" Then
        Range("A20").Select
        Selection.Copy
        Range("B21").Select
        ActiveSheet.Paste
        Range("B20").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("A21").Select
        ActiveSheet.Paste
        Range("C21") = Time
        Range("D21").Select
    Else
     
    If Range("A22") = "" Then
        Range("A21").Select
        Selection.Copy
        Range("B22").Select
        ActiveSheet.Paste
        Range("B21").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("A22").Select
        ActiveSheet.Paste
        Range("C22") = Time
        Range("D22").Select
    Else
    
    If Range("A23") = "" Then
        Range("A22").Select
        Selection.Copy
        Range("B23").Select
        ActiveSheet.Paste
        Range("B22").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("A23").Select
        ActiveSheet.Paste
        Range("C23") = Time
        Range("D23").Select
        
    End If
    End If
    End If
    End If
    End If
    End If
    
End Sub

Gibt es eine Möglichkeit das anzufertigen, dass er automatisiert die Zeilen hochzählt ohne dass ich jede Zeile einzeln angeben muss? Wäre echt einiges an arbeit...

Danke schon einmal im Voraus.

 

[lookshe]

Kleiner Tipp:

Du musst nicht

Range("A17")

fest machen, es geht auch

Dim Counter As Integer
Counter = 10
Range("A" & Counter)

Somit kannst du einfach die Zeilen durchgehen, bis du eine leere findest.
Es geht auch einfacher mit Cells("A0:A65000).End(xlUp) oder so ähnlich. Damit sollte die erste freie Zelle nach der letzten befüllten ausgewählt werden. Mit Google sollte sich der entsprechend korrekte Befehl schnell finden lassen.