Incrementer une formule
Bonjour à tous,
Pour les besoins d’un classeur, j’ai créé une macro qui a pour bue de copier une formule qui est en J2, de J3 jusqu’à la dernière cellule occupée de la colonne A.
Je crée bien ma formule en J2, mais elle n’est pas copiée et je n’ai aucun message d’alerte.
Pouvez-vous m’aider, d’avance merci?
Cordialement.
Mistral
Bonjour,
Peut-être ainsi :
Sub Macro3()
Dim Derniere_Ligne As Long
' Validation variable.
Derniere_Ligne = Range("A" & Rows.Count).End(xlUp).Row
' Insertion de la colonne J et création en tête.
Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Value = "Rep. Origine" ' Nom de la colonne.
' Création formule répertoire d'origine.
With Range("J2")
.FormulaR1C1 = "=IF(RC[-9]="""","""",""OK"")"
.AutoFill Destination:=.Resize(Derniere_Ligne)
End With
End SubBonne découverte du VBA
Bonne fin d'apm
Bonsoir Cousinhub,
Tout d'abord merci pour ton aide.
Je viens de tester et cela fonctionne plutot bien à un bémole pres.
En effet j'incremente la formule sur une cellule de plus que sur la colonne A.
Je pourrais faire -1 sur la valeur de "Derniere_Ligne" mais il y a surement une autre expliquation.
Mais la quelle?
Re-,
Je ne comprends pas ton "Bémol"...
Je viens de refaire un essai (avec ton fichier initial), et la formule va bien de J2 à J61 :
En fait sur la classeur il n'y a qu'une partie de la macro finale.
J'ai copié ta proposition dans ma macro et là je vais une cellule plus bas.
Ce n'est pas gênant en soi mais pas très propre.
Avant que tu ne ma pose la question je ne pourrais pas t'envoyer mon classeur complet car ça fait appel à des repertoire que tu n'auras pas.
Par contre je te mets ci dessous la macro complete, si tu pouvais y jeter un oeil.
Sub Creation_Palmares()
Dim Plage
Dim Nom_Repertoire As String
Dim Nom_Fichier As String
Dim Nom_Feuille As String
Dim Derniere_Ligne As Long
'******************************************
'* *
'* M.A.J de la feuille F_Palmares *
'* et récupération des donnes *
'* *
'******************************************
' Bloquage du rafraichissement et des alarmes.
Application.ScreenUpdating = False ' Bloque le rafraichissement de l'écran.
Application.EnableEvents = False ' Arret de la scrutation.
Application.DisplayAlerts = False ' Bloque les messages Excel.
' Gestion des feuilles
Sheets("Palmares").Visible = True 'Affichage de la feuille F_Palmares_S3.
Sheets("Menu").Select 'Sélection de la feuille Menu.
ActiveWindow.SelectedSheets.Visible = False 'Masquage de la feuille Menu.
' Positionne la nouvelle feuille.
Sheets("Palmares").Select
Sheets("Palmares").Move After:=Sheets(2)
Columns("A:L").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
' Validation variable.
Nom_Repertoire = Sheets("données").Range("M4").Value
Nom_Fichier = Sheets("données").Range("K4").Value
Nom_Feuille = Sheets("données").Range("K7").Value
' Récupération du nom de fichier palamres..
Workbooks.Open Filename:=Nom_Repertoire '"S:\French Digital Tour\Diaporama_FDT\F_Palmares_S3.xlsx" ' Ouverture du fichier palamres.
' Copie du palamres.
Set sh = Sheets(Nom_Feuille)
Col = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
l = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Set Plage = Range([A1], Cells(l, Col))
Plage.Select
Selection.Copy
'Retour au classeur d'origine et copie du F_Palmares_S3.
Windows("Crea_Diapo_W.xlsm").Activate
ActiveSheet.Paste
' Fermeture du classeur F_Palmares_S3.
Windows(Nom_Fichier).Activate
ActiveWindow.Close
Range("A1").Select
'****************************************
'* *
'* Incertion colonnes et création *
'* formules pour répertoires *
'* *
'****************************************
' Validation variable.
Derniere_Ligne = Range("A" & Rows.Count).End(xlUp).Row
' Insertion de la colonne J et création en tête.
Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Value = "Rep. Origine" ' Nom de la colonne.
' Création formule répertoire d'origine.
With Range("J2")
.FormulaR1C1 = "=VLOOKUP(RC2,Données!R4C2:R7C5,2,FALSE)" ' Formule RechercheV
.AutoFill Destination:=.Resize(Derniere_Ligne)
End With
' Création formule répertoire d'arrivée.
Range("L1").Select
ActiveCell.FormulaR1C1 = "Rep. Arrivée" ' Nom de la colonne.
Range("L1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With Range("L2")
.FormulaR1C1 = "=VLOOKUP(RC2,Données!R4C2:R7C5,4,FALSE)" ' Formule RechercheV"
.AutoFill Destination:=.Resize(Derniere_Ligne)
End With
Range("A1").Select
'****************************************
'* *
'* Mise en forme de la feuille *
'* F_Palmares_S3 *
'* *
'****************************************
' Sélection de la plage occupée.
Set sh = Sheets("Palmares")
Col = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
l = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Set Plage = Range([A1], Cells(l, Col))
Plage.Select
' Suppression du renvoi automatique à la ligne.
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Centrage_gauche Macro
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Police de caractère.
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
' Bordures des cellules.
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
' Ajustement largeur colonne de A à L.
Columns("A:L").Select
Columns("A:L").EntireColumn.AutoFit
Range("A1").Select
' Gestion de feuille.
Sheets("Menu").Visible = True 'Affichage de la feuille F_Palmares_S3.
Sheets("Palmares").Select 'Sélection de la feuille F_Palmares_S3.
ActiveWindow.SelectedSheets.Visible = False 'Masquage la feuille F_Palmares_S3.
' Rétablissement du rafraichissement et des alarmes.
Application.ScreenUpdating = True ' Bloque le rafraichissement de l'écran.
Application.EnableEvents = True ' Arret de la scrutation.
Application.DisplayAlerts = True ' Bloque les messages Excel.
MsgBox "L'onglet Palmares a été mis à jour."
End Sub