Etirer une formule VBA sur une colonne

Le 18/01/2017 à 10:52

Bonjour à tous le forum,

J'ai un petit problème que je n'arrive pas à résoudre, j'ai une formule en A2 que j'aimerais étendre sur toute la colonne A (jusqu'à la cellule 400 de cette colonne).

Ce sont des chiffres et des lettres, je veux que les chiffres, exemple: 00013003.08 - XXXXXXXX ("X" pour ne pas citer les noms des produits). Grâce à des recherches j'ai pu garder que les chiffres mais je voudrais l'étendre sur la colonne A en sachant que dans les cellules suivantes ce ne sont pas les mêmes produits (les chiffres à garder sont tous de la même longueur que l'exemple).

Je ne sais pas si j'ai bien expliqué ce que je voulais .

La formule que j'ai pour l'instant est la suivante:

Range("A2").Select

Cells(2,1) = Left(Cells(2,1), 12)

Range("A2").Select

Selection.AutoFill Destination:=Range("A2:A400")

Le début marche très bien mais c'est la suite que je n'arrive pas à faire, cela me copie les chiffres de la cellule A2 jusqu'à la cellule A400. Il faut savoir que parfois cela ne va pas jusqu'à la cellule 400.

Merci d'avance.

Le 18/01/2017 à 10:57
Sub Macro1()

For i = 2 To 400
    Cells(i, 1) = Left(Cells(i, 1), 12)
Next

End Sub
Le 18/01/2017 à 11:06

Cela ne marche pas : "Erreur de compilation: Variable non définie"

Je ne sais pas si c'est bon de préciser que c'est qu'un bout de toute la procédure.

Le 18/01/2017 à 12:56

Bonjour Benjiben, Melch,

Bonjour tout le monde!

Il te faudra comprendre que nous avons besoin, pour ne pas tourner en rond, d'un fichier dans sa structure réelle de travail!

Sans cela, n'importe qui tâtonnera dans le brouillard, faisant perdre son temps (bénévole, je te rappelle!) à tous!

Cela dit, AUTOFILL ne sert qu'à étirer une FORMULE Excel. Ce que tu veux étirer en A2, c'est une valeur : dans les conditions exposées, normal que ton code étire toujours les mêmes chiffres!

Sub Worksheet_SelectionChange()
'
iRow = Range("A" & Rows.count).End(xlUp).Row
For x = 2 To iRow
    Cells(x, 1) = Left(Cells(x, 1), 12)
Next
'
End Sub

A coller dans la feuille-cible!

Si ceci ne convient pas, reviens AVEC un fichier!

A+

Le 18/01/2017 à 13:19

Bonjour curulis57,

Oui c'est vrai qu'en joignant le fichier ce sera plus simple tu as raison, donc en pièce-jointe le fichier que j'ai appelé test.

D'accord je comprend mieux pourquoi cela étire le même chiffre que celui de la cellule A2, merci de ta précision sur ce point.

Voici donc le code entier de ma macro (ce qui est en rouge c'est la où cela me pose un problème):

Option Explicit

Dim derln&, dercol&, dercol2&, j&, f As Worksheet, fr As Worksheet

Sub Retardproduit13h()

Set f = ActiveSheet

'Range("A:B").Delete shift:=xlToLeft

Application.DisplayAlerts = False

Application.ScreenUpdating = False

dercol = Cells(1, Columns.Count).End(xlToLeft).Column

derln = Range("A" & Rows.Count).End(xlUp).Row

Sheets.Add After:=ActiveSheet

Sheets.Add After:=ActiveSheet

ActiveSheet.Name = "13h"

Set fr = ActiveSheet

f.Cells.Copy fr.Range("A1")

fr.Range("A:B").Delete shift:=xlToLeft

For j = dercol To 8 Step -1

If fr.Cells(1, j).Value * 24 <> 13 Then

fr.Columns(j).Delete

End If

Next j

If Range("H1") <> "" Then

Range("C2").FormulaR1C1 = "=RC[5]"

Call Extract

Else

fr.Delete

End If

End Sub

Sub Extract()

Range("C1") = "Manquant"

Range("C2:C" & derln).FillDown

Range("C2").Select

Columns("D:G").Delete shift:=xlToLeft

dercol2 = Cells(1, Columns.Count).End(xlToLeft).Column

With Range(Cells(2, 1), Cells(derln, dercol2))

.Sort key1:=Range("C2"), order1:=xlAscending, Header:=xlNo

.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _

Formula1:="=1", Formula2:="=40000"

.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Range(Cells(2, 1), Cells(derln, dercol2)).FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.Color = 255

.TintAndShade = 0

End With

.FormatConditions(1).StopIfTrue = False

End With

Range("C1").Select

Do While Range("C2") = 0

Range("C2").EntireRow.Delete shift:=xlUp

Loop

'

iRow = Range("A" & Rows.Count).End(xlUp).Row

For x = 2 To iRow

Cells(x, 1) = Left(Cells(x, 1), 12)

Next

'

Range("F2").Select

ActiveCell.FormulaR1C1 = "PC"

With ActiveCell.Characters(Start:=1, Length:=2).Font

.Name = "Arial"

.FontStyle = "Normal"

.Size = 10

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

.TintAndShade = 0

.ThemeFont = xlThemeFontNone

End With

Range("F3").Select

ActiveCell.FormulaR1C1 = "Traiteur"

With ActiveCell.Characters(Start:=1, Length:=8).Font

.Name = "Arial"

.FontStyle = "Normal"

.Size = 10

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

.TintAndShade = 0

.ThemeFont = xlThemeFontNone

End With

Range("F4").Select

ActiveCell.FormulaR1C1 = "SDW"

With ActiveCell.Characters(Start:=1, Length:=3).Font

.Name = "Arial"

.FontStyle = "Normal"

.Size = 10

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

.TintAndShade = 0

.ThemeFont = xlThemeFontNone

End With

Range("G2").Select

ActiveCell.FormulaR1C1 = "=SUM(R2C3:R400C3)-R[1]C-R[2]C"

Range("G3").Select

ActiveCell.FormulaR1C1 = _

"=SUMIFS(R2C3:R400C3,R2C1:R400C1,""<=14000"",R2C1:R400C1,"">=13000"")"

Range("G4").Select

ActiveCell.FormulaR1C1 = _

"=SUMIFS(R2C3:R400C3,R2C1:R400C1,""<=33000"",R2C1:R400C1,"">=30100"")"

End Sub

35test.xlsx (9.03 Ko)
Le 18/01/2017 à 13:34
Sub Macro1()

Dim i as integer

For i = 2 To 400
    Cells(i, 3) = Left(Cells(i, 3), 12)
Next

End Sub
Le 18/01/2017 à 13:58

Bonjour.

Essayer range(x:y).filldown

x étant première cellule contenant la formule

y étant la dernière cellule qui doit la recevoir

Cordialement.

Le 18/01/2017 à 14:12

Melch la macro ne me change rien dans mon tableau final.

AYARI Moncef cela me fait la même chose que ce que je faisais au début c'est à dire que cela recopie la cellule A2 jusqu'à A400.

Le 18/01/2017 à 14:42

Bonjour.

Sub CopierVersLeBas() macro avec touche de raccourci Ctrl+a

Selection.FillDown

End Sub

Vous avez une formule à une cellule donnée : exp C3

et vous voulez copier la formule sur les cellules suivantes, jusqu'à le cellule C10 par exemple.

Alors sélectionnez C3 à C10 et taper Ctrl+a

la macro CopierVersLeBasSansSelection comme son nom l'indique ne nécessite pas la selection préalable.

Cordialement.

50copieverslebas.xlsm (13.27 Ko)
Le 18/01/2017 à 15:24

J'ai compris ton explication mais je n'arrive pas à le retranscrire pour mon tableau.

En gros dans la colonne A c'est variable ce ne sont jamais les mêmes chiffres, donc je veux juste que la formule présente en A2 puisse s'appliquer à toutes les cellules dans la colonne A.

Exemple :

A2 00013003.08 - XXXXXX

A3 00030525.08 - XXXXXX,

A4 00031055.04 - XXXXXX etc...

J'obtiens bien que les chiffres avec le début de la formule et je voudrais obtenir que les chiffres pour toute la colonne A.

Le 18/01/2017 à 16:31

Bonjour,

Quand les explications ne sont pas claires, les réponses vont tout azimut !

Admettons que tu souhaites avoir en colonne A de la feuille active à partir de A2 l'extraction des douze chiffres qui se trouvent en colonne C et ce jusqu'à la dernière cellule de la colonne C :

Sub TirerFormule()

    Dim I As Long

    With ActiveSheet

        I = .Cells(Rows.Count, 3).End(xlUp).Row 'sur colonne C

        .Range("A2").Formula = "=LEFT(C2,12)"
        .Range("A2").AutoFill .Range("A2:A" & I)

    End With

End Sub
Le 19/01/2017 à 09:11

Bonjour,

Je vais essayé d'expliquer au plus simple mais ce n'est pas évident.

Le première feuille comprend toutes les données de l'extraction que je fait manuellement, en faisant la macro une nouvelle feuille s'ouvre (onglet 13h pour le fichier joint) et il me reste que les données nécessaires. Les colonnes qui ne me servent pas sont supprimées avec la macro.

Comme tu as dit je souhaite avoir en colonne A de la feuille appelée 13h, à partir de A2 les douze chiffres, au début de la macro la colonne A et B sont supprimés ce qui fait que les chiffres ne se sont plus en colonne C. 'Range("A:B").Delete shift:=xlToLeft.

Le 19/01/2017 à 10:38

J'ai réfléchi et je pense que le plus simple c'est que je vais rajouter une colonne supplémentaire en B et appliquer la formule dans cette colonne, c'est à dire un truc du genre:

Range("B2").Select

ActiveCell.FormulaR1C1= "=left(A2,12)"

Range("B2").Select

Selection.Autofill Destination:=Range("B2:B400")

Mais j'ai du me tromper quelque part puisque cela me marque "#NOM?" dans la colonne ...

Le 19/01/2017 à 10:44
benjiben a écrit :

J'ai réfléchi et je pense que le plus simple c'est que je vais rajouter une colonne supplémentaire en B et appliquer la formule dans cette colonne, c'est à dire un truc du genre:

Range("B2").Select

ActiveCell.FormulaR1C1= "=left(A2,12)"

Range("B2").Select

Selection.Autofill Destination:=Range("B2:B400")

Mais j'ai du me tromper quelque part puisque cela me marque "#NOM?" dans la colonne ...

Si tu as un excel français, change la ligne :

ActiveCell.FormulaR1C1= "=left(A2,12)"

en la ligne suivante :

ActiveCell.FormulaR1C1= "=gauche(A2,12)"
Le 19/01/2017 à 10:52

Oui c'est en français j'ai changé comme tu l'as dit mais ça me marque toujours #NOM? dans la colonne B

Le 19/01/2017 à 10:56

Bonjour.

Essayer cette macro :

Sub CopierVersLeBasSansSelection()

'

' Codes vba précedant la décision de copie

'

'Vous êtes là et vous voulez copier vers le bas la cellule B2 jusqu'à B19

Range("B2").FormulaLocal = "=" & "GAUCHE(A2;12)"

Range("B2:B19").FillDown

'Vous continuez votre code

'

' Codes vba suivant la décision de copie

'

End Sub

Cordialement

27copieverslebas.xlsm (13.89 Ko)
Le 19/01/2017 à 11:14

Bonjour,

A partir de la macro de Theze (salutations), pourquoi pas :

Sub Tirer()
Dim I As Long
    With ActiveSheet
        I = .Cells(Rows.Count, 3).End(xlUp).Row 'sur colonne C
        .Range("A2:A" & I).Formula = "=LEFT(C2,12)"
    End With
End Sub
Le 19/01/2017 à 11:19

Ça marche c'est parfait merci AYARI Moncef, j'obtiens dans la colonne B ce que je voulais.

Et maintenant comme dans l'exemple j'ai des 0 devant, en faisant *1 cela les supprime mais me met valeur dans les cellules suivantes quand il y a rien ...

Un grand merci tout de même à tous ceux qui ont pris le temps de m'aider !

Le 19/01/2017 à 16:04

Bonjour,

Là, je crois qu'il y a mélange entre "Formula", "FormulaR1C1", "FormulaLocal" et "FormulaLocalR1C1". Voir le code ci-dessous avec les commentaires :

Sub Test()

    'ici, la formule est en Anglais et la référence en "$A$1"<-- en absolue "A1"<-- en relative
    '(Excel fait la transformation en fonction des paramètres régionaux)
    Range("A2").Formula = "=LEFT(C2,12)"

    'ici, la formule doit être en Français si Excel est Français. Attention à mettre un point-virgule et non une virgule !
    Range("A2").FormulaLocal = "=GAUCHE(C2;12)"

    'ici, la formule est en Anglais et la référence en "R1C1"<-- en absolue R[1]C[1]<-- en relative
    '(Excel fait la transformation en fonction des paramètres régionaux)
    Range("A2").FormulaR1C1 = "=LEFT(R2C3,12)"

    'ici, la formule doit être en Français si Excel est Français et la référence en "L1C1"<-- en absolue L(1)C(1)<-- en relative
    'R devient L et les crochets, des parenthèses ! Attention à mettre un point-virgule et non une virgule !
    Range("A2").FormulaR1C1Local = "=GAUCHE(L2C3;12)"

End Sub
Rechercher des sujets similaires à "etirer formule vba colonne"