Automatisches Ausfüllen der Zelle in Excel VBA Makro

Question

Sub AutoFill() 

    Dim x As Long 
    Dim y As Long 
    Dim lastrow As Long 
    Dim lastcolumn As Long 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 

    lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count 
    lastrow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count 

    For x = 2 To lastrow 
     If Cells(x, 2).Value = "" Then 
      Cells(x, 2).Value = Cells(x - 1, 2).Value 
      Cells(x, 3).Value = Cells(x - 1, 3).Value 
      Cells(x, 5).Value = Cells(x - 1, 5).Value 
     End If 
    Next x 

    Application.ScreenUpdating = True 

End Sub 

Mit dem obigen Code Meine Zellen werden gefüllt, aber die letzte Zeile füllt bis zum Ende der Excel-Tabelle. In der Excel-Tabelle ist die Spalte bereits in Spalte BC & E ausgefüllt, sollte automatisch nach unten gefüllt werden. Was sollten die Änderungen im Code sein?

Answer 1

Excel VBA Last Row: The Complete Tutorial To Finding The Last Row In Excel With VBA (And Code Examples) empfiehlt die Verwendung bei der Bestimmung der letzten mit Cells.Find.

lastrow = Find(What:=” * ”, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

Da Sie angegeben, dass der Spalte D bereits gefüllt ist, in die ich benutze:

lastrow = Range("D" & Rows.Count).End(xlUp).Row 

Wenn Spalte E in nicht gefüllt ist, dann muss Cells(x, 2).Value<> "" sein.

Sub AutoFill() 
    Dim x As Long 
    Dim y As Long 
    Dim lastrow As Long 
    Dim lastcolumn As Long 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 

    lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count 
    lastrow = Range("D" & Rows.Count).End(xlUp).Row 

    For x = 2 To lastrow 

     If Cells(x, 2).Value = "" Then Cells(x, 2).Value = Cells(x - 1, 2).Value 
     If Cells(x, 3).Value = "" Then Cells(x, 3).Value = Cells(x - 1, 3).Value 
     If Cells(x, 5).Value = "" Then Cells(x, 5).Value = Cells(x - 1, 4).Value 

    Next x 
    Application.ScreenUpdating = True 

End Sub