VBA - Copie d'une cellule avec AutoFill

Bonjour à tous,

Je suis débutant en vba et n'ai pas trouvé la réponse sur le forum. J'espère que vous pourrez m'aider :)
J'ai un fichier d'importation de données dans lequel j'effectue quelques retraitement directement dans le code VBA après importation des données.

Sauriez-vous comment remplir avec Autofill une colonne avec une formule de la première cellule vide jusqu'au niveau de la dernière cellule non vide d'une autre colonne ?

C'est à dire ici, copier de la première cellule vide en AB jusqu'à la ligne de la dernière cellule non vide de la colonne B (après importation de nouvelles données)

Le fichier est un fichier de suivi et le but est de pourvoir consolider plusieurs importations de données. Une autre macro appelle ensuite celle-ci puis copie en valeur toute la base pour alléger le fichier.

Voici le code qui ne fonctionne pas (seule la partie

WS1.Range("AB3").AutoFill Destination:=WS1.Range("drLigbis+1:AB" & drLig)
ne fonctionne pas) :
Sub ImportExtraction()
On Error GoTo err
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim lig1&, lig2&, derlig1&, derlig2&, finlig1&
Dim NomFichier As String
Dim data_range, formule_range As Range
Dim WS1 As Worksheet, WS2 As Worksheet
Dim Wkb As Workbook
Dim drLig, drLigbis As Long
Dim i As Integer

'Ouvre le fichier à consolider
NomFichier = Application.GetOpenFilename("Excel Files, *.xls*")
If NomFichier = "" Then
MsgBox "Aucune donnée importée"
Application.ScreenUpdating = True
Exit Sub
End If

Set Wkb = Workbooks.Open(NomFichier)

'Importe les données dans l'onglet Data
Set WS1 = ThisWorkbook.Worksheets("Data")
Set WS2 = Wkb.Worksheets("Feuil1")
Set WS2 = Workbooks.Open(NomFichier).Worksheets("Data")
derlig2 = WS2.Cells(WS2.Rows.Count, 1).End(xlUp).Row
Set data_range = WS2.Range(Cells(2, 1).Address(), Cells(derlig2, 20).Address())
derlig1 = WS1.Cells(WS1.Rows.Count, 1).End(xlUp).Row
data_range.Copy Destination:=WS1.Cells(derlig1 + 1, 1)
finlig1 = WS1.Cells(WS1.Rows.Count, 1).End(xlUp).Row
Set formule_range = WS1.Range("V1:AH1")
formule_range.Copy Destination:=WS1.Cells(derlig1 + 1, 22)

'copie les formules jusqu'à la dernière ligne de données

drLig = WS1.Range("B" & Rows.Count).End(xlUp).Row
drLigbis = WS1.Range("AB" & Rows.Count).End(xlUp).Row
WS1.Range("V3").AutoFill Destination:=WS1.Range("V3:V" & drLig)
WS1.Range("W3").AutoFill Destination:=WS1.Range("W3:W" & drLig)
WS1.Range("X3").AutoFill Destination:=WS1.Range("X3:X" & drLig)
WS1.Range("Y3").AutoFill Destination:=WS1.Range("Y3:Y" & drLig)
WS1.Range("Z3").AutoFill Destination:=WS1.Range("Z3:Z" & drLig)
WS1.Range("AA3").AutoFill Destination:=WS1.Range("AA3:AA" & drLig)
WS1.Range("AB3").AutoFill Destination:=WS1.Range("drLigbis+1:AB" & drLig)
WS1.Range("AC3").AutoFill Destination:=WS1.Range("AC3:AC" & drLig)
WS1.Range("AD3").AutoFill Destination:=WS1.Range("AD3:AD" & drLig)

'ferme le fichier importé et affiche un message
Wkb.Close False
MsgBox ("Import effectué, deuxième étape en cours...")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

err:
MsgBox ("Erreur, l'importation n'a pas été effectuée.")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Merci pour votre aide :)

Cordialement

6exemple-macro.zip (65.08 Ko)
Rechercher des sujets similaires à "vba copie autofill"