Autosize dans une colonne variable

Version imprimable

Bonjour,

Je dois réaliser un tableur Excel durant mon stage et il faudrait qu'il soit automatisé le plus possible. Je débute dans les macro Excel donc elle ne sont pas forcement très poussées :/

La macro sur laquelle je bloque consiste en fait a insérer une colonne, y rentrer un titre, insérer une fonction dans la première cellule. Fonction que voici =(DROITE(B2;NBCAR(B2)-2) et donc comme elle utilise la colonne B, je veux qu'elle s'arrête sur la même ligne que la colonne B.

Et donc j'obtiens ceci :
Code:

1 2 3 4 5 6 7 8 9 10 11 Range("A1").Select Selection.EntireColumn.Insert ActiveCell.FormulaR1C1 = "NoFactureRetraité" Range("A2").Select ActiveSheet.Paste Range("A2").Select ActiveCell.FormulaR1C1 = "=(RIGHT(RC[1],LEN(RC[1])-2))" Range("A2").Select Selection.AutoFill Destination:=Range("A2:A1546") Range("A2:A1546").Select End Sub
Le problème c'est que le nombre de ligne peut varier et donc le A1546 n'est pas adapté a ce que je veux faire.

Si vous pouviez m'aider la dessus svp, ca me sauverait mon tableau qui va beaucoup fonctionner sur ce principe d'étendre une rechercheV ou autre formule, au même niveau que la ligne dans laquelle le critère est écrit. ^^

Bonne journée ;)

J'ai testé ça, ça marche :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Pouet()
 
    Dim xlsWs As Excel.Worksheet
    Dim nbRow As Integer
 
    Set xlsWs = ThisWorkbook.Worksheets("TaFeuille")
 
'Insertion d'une nouvelle colonne avant la colonne A
    xlsWs.Range("A1").EntireColumn.Insert
'Ajout du titre en A1
    xlsWs.Range("A1").Value = "NoFactureRetraité"
'Ajout de la formule en A2
    xlsWs.Range("A2").Formula = "=Right(B2, Len(B2) - 2)"
'Récupération du nombre de lignes
    nbRow = xlsWs.Range("B2").End(xlDown).Row
'Copie de la formule sur les lignes suivantes
    xlsWs.Range("A2").AutoFill Destination:=xlsWs.Range("A2:A" & nbRow)
 
End Sub

Par contre, les données à traiter avant d'exécuter la macro sont dans la colonne A? Car l'insertion d'une nouvelle colonne les déplace en B et les résultats s'affichent en A.

Bonjour

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                        'à adapter selon le nom de ta feuille
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Columns(1).Insert
    .Range("A1") = "NoFactureRetraité"
    With .Range("A2:A" & LastLig)
        .FormulaR1C1 = "=RIGHT(RC[1],LEN(RC[1])-2)"
        .Value = .Value
    End With
End With

15/07/2011, 11h45
kapow

Super, les deux solutions marchent du tonnerre !

Merci beaucoup à tout les deux pour l'efficacité et la rapidité de vos réponses :)

Au plaisir !

Rebonjour !

Je me permet de revenir vous voir car malgré après avoir retravaillé la première solution que vous m'avez donné, je n'arrive pas a terminer mon tableau.

Il s'agit cette fois d'étendre des formules se trouvant déja sur le tableau (sur la ligne 4 et doivent être étenduent a partir de la ligne 6), mais cette fois il s'agit de plusieurs colonne et toujours de s'arreter quand il n'y a plus rien dans la colonne référence (ici la A)
Code:

1 2 3 4 5 6 7 Range("B4:K4").Select Selection.Copy Range("B6").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.AutoFill Destination:=Range("B6:K433") Range("B6:K433").Select
Les formules sont toutes des "recherchev" sauf la dernière la K qui est "=SI(ESTERREUR(c6);"Payé";"Impayé")"

J'ai pensé a les faire individuellement après avoir copié collé la formule se trouvant donc au dessus, même si ca représente une vingtaine de colonne ca m'a donné ca :
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim xlsWs As Excel.Worksheet Dim nbRow As Integer Set xlsWs = ThisWorkbook.Worksheets("3128") 'Ajout de la formule en A2 xlsWs.Range("b6").Formula = "=RECHERCHEV(A6;'Balance SAP'!$A$1:$I$10001;9;FAUX)"'Récupération du nombre de lignes nbRow = xlsWs.Range("A6").End(xlDown).Row 'Copie de la formule sur les lignes suivantes xlsWs.Range("A6").AutoFill Destination:=xlsWs.Range("B6:B" & nbRow)
(il m'indique une erreur en rouge)

Si vous avez une solution et même mieux, de quoi le faire pour toutes les colonnes en un coup je suis preneur ^^ les formules vont de B6 a K6 et donc la fin serait variable, allant de 60lignes a 3000+

Merci encore de votre aide ! :)

Code:

1
2
3
4
5
6
7
8
9
Sub test()
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                                   'à adapter selon le nom de ta feuille
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("B4:K4").Copy .Range("B6:K" & LastLig)
End With
End Sub

à combiner avec le premier code