Discussion :

[hicham28]

Bonjour,
Merci en avance de votre aide,
J’ai eu ce code dans un forum, Je pense que ça réponds a mon objectif pour recopier les fonctions du linge précèdent sur une feuil de calcule, mais j’arrive pas a paramètre merci de m’avoir expliquer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Dim Fin As Integer
Range("a6").Select
Fin = Range("a1").End(xlDown).Row
Range("b1").Copy
Range("b1:D" & Fin).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

[mercatog]

Tu as une formule en B1 et tu veux la copier dans B1.Dfin
je propose autofill

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim Fin As Long
Fin = Range("A1").End(xlDown).Row
Range("B1").AutoFill Destination:=Range("B1:D1")
Range("B1:D1").AutoFill Destination:=Range("B1:D" & Fin)

[hicham28]

merci pour ta reponse,
Normalement le code sert a recopier la formules de B1 C1 D1, a conditions que la cellule A correspondante a la linge ne soit pas vide. le problemes c'est quand je change la cellule de depart A6 ca n'amene a rien. je comprends rien ...
merci

[mercatog]

Le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Fin = Range("A1").End(xlDown).Row

s'arrête à la première cellule vide de la colonne A.
essaie ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim Fin As Long, i As Long
Fin = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Fin
    If Range("A" & i).Value <> "" Then Range("B1:D1").Copy Range("B" & i & ":D" & i)
Next i

[hicham28]

merci, je l'es presenter comme suite, est ce que c'est correcte?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Fin As Long, i As Long
Fin = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Fin
    If Range("A" & i).Value <> "" Then Range("B1:D1").Copy Range("B" & i & ":D" & i)
Next i
End Sub

et si j'aimerai changer le point de depart pour la colonne A je dois faire comment?
merci c'est gentil

[mercatog]

Tu veux que la copie ne commence qu'après la ligne 6 ou quoi?

[hicham28]

j'aimerai bien savoir comment mettre pour changer le point de depart pour la colonne A? comment proceder pour que la copie des fonctions commence a A6 par exemple ou autre cellule de la colonne A.
merci je suis vraiment dsl

[mercatog]

Un exemple de procédure avec comme paramètre la ligne de départ

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub Test(ByVal Deb As Long)
Dim Fin As Long, i As Long
Fin = Cells(Rows.Count, 1).End(xlUp).Row
For i = Deb + 1 To Fin
    If Range("A" & i).Value <> "" Then Range("B" & Deb & ":D" & Deb).Copy Range("B" & i & ":D" & i)
Next i
End Sub

par exemple, si on fait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub CommandButton1_Click()
Test 6  'Ligne de formule à copier en bas
End Sub

la formule de B6.D6 sera copier vers le bas

[hicham28]

merci de vos reponses,



voila le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("a1:a1000")) Is Nothing Then
Dim Fin As Long, i As Long
Fin = Cells(Rows.Count, 1).End(xlUp).Row
For i = 16 To Fin
If Range("A" & i).Value <> "" Then Range("A" & i).RowHeight = 14
Range("E3:ES3").Copy Range("E" & i & ":ES" & i)
Range("E" & i & ":ES" & i).RowHeight = 14
Next i
End If
End Sub

c'est presque le resulat que j'aimerai avoir, reste une seule chose, que j'aimerai en avoir une solution par votre aide,
j'aimerai que la copies des formules prends fin dé la premiere cellule de colonne D non vide.
merci encore

[mercatog]

Par exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Fin As Long, i As Long
If Target.Cells.Count = 1 Then
    Fin = Cells(Rows.Count, 1).End(xlUp).Row
    If Not Application.Intersect(Target, Range("A1:A" & Fin)) Is Nothing Then
        For i = 16 To Fin
            If Range("D" & i) <> "" Then
                Exit For
            Else
                If Range("A" & i).Value <> "" Then
                    Range("E3:ES3").Copy Range("E" & i)
                    Rows(i).RowHeight = 14
                End If
            End If
        Next i
    End If
End If
End Sub

[hicham28]

merci millllle merci a vous mercatog