Cellule de remplissage automatique dans Excel VBA Macro

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 

Avec le code ci-dessus Mes cellules sont remplies, mais la dernière ligne se remplit jusqu'à la fin de la feuille Excel. Dans la feuille Excel, la colonne D est déjà renseignée. La colonne BC & E doit être remplie automatiquement. Quels devraient être les changements dans le code?

Answer 1

Excel VBA Last Row: The Complete Tutorial To Finding The Last Row In Excel With VBA (And Code Examples) recommande d'utiliser LookIn:=xlFormulas lors de la détermination du dernier à l'aide de Cells.Find.

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

Parce que vous avez déclaré que la colonne D est déjà rempli que j'utilise:

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

Si la colonne E n'est pas remplie alors Cells(x, 2).Value doit être <> "".

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