Modification d'une ligne dans mon code

Version imprimable

Bonjour à vous tous

Voila je viens vers vous afin de trouver la solution à mon problème, en effet j'ai ci dessous une macro qui répond totalement à mes besoins sauf un à point auquel je veux modifier

Car ici dans mon code les données à copier sont spécifiées ce trouvant dans toute la colonne B à partir de B2 et si je décale les donnée d'une ligne par exemple la copie ne ce fait pas vraiment comme que je veux, moi je souhaite déterminer une plage bien précise c'est à dire exemple copier les information qui se trouvent de B2 à B10

Je joins mon code ci-dessous et étant débutant en VBA je pense la modification sera dans la ligne 18 ou 19 ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Dim DernierID As Integer
Dim LigneVide As Integer
Dim Formule As Long
Dim i As Long
 
Sub Copier_Coller()
 If Sheets("Facture").Range("A1").Value Like "*CFA*" Then
     Sheets("CFA").Select
    ElseIf Sheets("Facture").Range("A1").Value Like "*UREA*" Then
        Sheets("UREA").Select
    Else
        Sheets("UFI").Select
 End If
    DernierID = WorksheetFunction.Max(ActiveSheet.Range("A:A"))
    LigneVide = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
 If LigneVide < 2 Then LigneVide = 2
    ActiveSheet.Cells(LigneVide, 1) = DernierID + 1
 For i = 2 To Sheets("Facture").Range("B" & Rows.Count).End(xlUp).Row
    ActiveSheet.Cells(LigneVide, i) = Sheets("Facture").Range("B" & i)
 Next
 If ActiveSheet.Name = "CFA" Then
      Formule = Sheets("CFA").Cells(Rows.Count, "A").End(xlUp).Row
      ActiveSheet.Range("$L$" & Formule & "").FormulaLocal = "=SIERREUR(SOMME($J$" & Formule & ":$K$" & Formule & ");""Attention ! il y a une erreur !"")"
    ElseIf ActiveSheet.Name = "UREA" Then
      Formule = Sheets("UREA").Cells(Rows.Count, "A").End(xlUp).Row
      ActiveSheet.Range("$L$" & Formule & "").FormulaLocal = "=SIERREUR(SOMME($J$" & Formule & ":$K$" & Formule & ");""Attention ! il y a une erreur !"")"
    ElseIf ActiveSheet.Name = "UFI" Then
      Formule = Sheets("UFI").Cells(Rows.Count, "A").End(xlUp).Row
      ActiveSheet.Range("$L$" & Formule & "").FormulaLocal = "=SIERREUR(SOMME($J$" & Formule & ":$K$" & Formule & ");""Attention ! il y a une erreur !"")"
  End If
 Application.ScreenUpdating = True
End Sub

Merci à vous tous

Cordialement

Salut,
Pourquoi ne pas passer la plage en paramètre:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Copier_Coller(CopyRange As String)
    Dim sh As Worksheet
    Dim sFormula As String
    With Worksheets("Facture").Range("A1")
        If .Value Like "*CFA*" Then
            Set sh = Sheets("CFA")
 
        ElseIf .Value Like "*UREA*" Then
            Set sh = Sheets("UREA")
 
        Else
            Set sh =Sheets("UFI")
 
        End If
    End With
 
    Dim DernierID As Integer
    DernierID = WorksheetFunction.Max(sh.Range("A:A"))
 
    Dim lignevide As Integer
    lignevide = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
    If lignevide < 2 Then lignevide = 2
 
    sh.Cells(lignevide, 1) = DernierID + 1
 
    ' // D'après ce que j'ai compris tu veux mettre les valeurs sur la même ligne , mais je me trope peut-être
    sh.Range("B" & lignevide).Resize(, Range(CopyRange).Count) = Application.Transpose(Range(CopyRange))
    sFormula = "=SIERREUR(SOMME($J$" & lignevide & ":$K$" & lignevide & ");""Attention ! il y a une erreur !"")"
    sh.Cells(lignevide + 1, "L").FormulaLocal = sFormula

Et pour l'appel :

Code:

1
2
3
Private Sub CommandButton1_Click() 
     Copier_Coller "Facture!B2:B10"
End Sub

Salut, en supposant que j'ai bien compris, voici une autre approche possible, tu sélectionnes les cellules dans ta colonne B et ensuite tu lances la macro.
En passant, je te signale qu'il n'est pas nécessaire de faire un .Select sur les feuilles pour lire ou écrire des données.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub Copier_Coller()
    Dim wsFacture As Worksheet
    Dim wsDestination As Worksheet
    Dim dernierID As Long
    Dim ligneVide As Long
    Dim i As Long
    Dim formule As String
    Dim selectedRange As Range
    Dim copieRange As Range
 
    Application.ScreenUpdating = False
 
    Set wsFacture = Sheets("Facture")
    Select Case True
        Case wsFacture.Range("A1").Value Like "*CFA*"
            Set wsDestination = Sheets("CFA")
        Case wsFacture.Range("A1").Value Like "*UREA*"
            Set wsDestination = Sheets("UREA")
        Case Else
            Set wsDestination = Sheets("UFI")
    End Select
 
    Set selectedRange = Selection.Columns(2)
    If Not selectedRange Is Nothing Then
        ligneVide = wsDestination.Cells(Rows.Count, "A").End(xlUp).Row + 1
        If ligneVide < 2 Then ligneVide = 2
 
        Set copieRange = wsFacture.Range("B2:B" & wsFacture.Range("B" & Rows.Count).End(xlUp).Row)
        With wsDestination.Range("B" & ligneVide)
            .Resize(copieRange.Rows.Count, 1).Value = copieRange.Value
        End With
 
        dernierID = WorksheetFunction.Max(wsDestination.Range("A:A"))
        wsDestination.Cells(ligneVide, 1).Value = dernierID + 1
 
        formule = "=SIERREUR(SUM($J" & ligneVide & ":$K" & ligneVide & "), ""Attention ! Il y a une erreur !"")"
        wsDestination.Range("$L$" & ligneVide).FormulaLocal = formule
 
    Else
        MsgBox "Veuillez sélectionner la colonne B de la feuille Facture", vbCritical, "Erreur de sélection"
    End If
 
    Application.ScreenUpdating = True
 
End Sub

30/04/2023, 19h09
INFINITY100

1 pièce(s) jointe(s)

Merci Franc et Valtrase pour vos réponses

En essayant vos code franchement je me perd un peu :D

Donc pour être plus claire voici mon fichier joins avec exactitude de ce que je veux avoir comme solution

Merci infiniment à vous tous

Citation:

Envoyé par Valtrase

Salut,
Pourquoi ne pas passer la plage en paramètre:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Copier_Coller(CopyRange As String)
    Dim sh As Worksheet
    Dim sFormula As String
    With Worksheets("Facture").Range("A1")
        If .Value Like "*CFA*" Then
            Set sh = Sheets("CFA")
 
        ElseIf .Value Like "*UREA*" Then
            Set sh = Sheets("UREA")
 
        Else
            Set sh =Sheets("UFI")
 
        End If
    End With
 
    Dim DernierID As Integer
    DernierID = WorksheetFunction.Max(sh.Range("A:A"))
 
    Dim lignevide As Integer
    lignevide = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
    If lignevide < 2 Then lignevide = 2
 
    sh.Cells(lignevide, 1) = DernierID + 1
 
    ' // D'après ce que j'ai compris tu veux mettre les valeurs sur la même ligne , mais je me trope peut-être
    sh.Range("B" & lignevide).Resize(, Range(CopyRange).Count) = Application.Transpose(Range(CopyRange))
    sFormula = "=SIERREUR(SOMME($J$" & lignevide & ":$K$" & lignevide & ");""Attention ! il y a une erreur !"")"
    sh.Cells(lignevide + 1, "L").FormulaLocal = sFormula

Et pour l'appel :

Code:

1
2
3
Private Sub CommandButton1_Click() 
     Copier_Coller "Facture!B2:B10"
End Sub

Merci Valtrase après cassement de tête ton code semble fonctionner assez bien et copie les données comme je désir et je l'ai juste modifié ainsi :

j'ai ajouté une autre variable formula2 pour une autre formule

Dim sFormula2 As String

sFormula2 = "=SIERREUR(SOMME($m$" & lignevide & ":$n$" & lignevide & ");""Attention ! il y a une erreur !"")"
sh.Cells(lignevide, "o").FormulaLocal = sFormula2

ce qui nous donne le code final :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Dim sh As Worksheet
Dim sFormula As String
Dim sFormula2 As String
Dim DernierID As Integer
Dim lignevide As Integer
 
Sub Copier_Coller(CopyRange As String)
    With Worksheets("Facture").Range("A1")
        If .Value Like "*CFA*" Then
            Set sh = Sheets("CFA")
 
        ElseIf .Value Like "*UREA*" Then
            Set sh = Sheets("UREA")
         Else
            Set sh = Sheets("UFI")
         End If
    End With
    DernierID = WorksheetFunction.Max(sh.Range("A:A"))
    lignevide = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
 If lignevide < 2 Then lignevide = 2
    sh.Cells(lignevide, 1) = DernierID + 1
    sh.Range("B" & lignevide).Resize(, Range(CopyRange).Count) = Application.Transpose(Range(CopyRange))
    sFormula = "=SIERREUR(SOMME($J$" & lignevide & ":$K$" & lignevide & ");""Attention ! il y a une erreur !"")"
    sFormula2 = "=SIERREUR(SOMME($m$" & lignevide & ":$n$" & lignevide & ");""Attention ! il y a une erreur !"")"
    sh.Cells(lignevide, "L").FormulaLocal = sFormula
    sh.Cells(lignevide, "o").FormulaLocal = sFormula2
End Sub

Et pour l'appel :

Code:

1
2
3
Sub Validation()
    Copier_Coller "Facture!B2:B10"
End Sub

et le tour est joué :D

Merci Franc au passage

30/04/2023, 22h13
Valtrase

Salut,
Si tu as trouvé des réponses pertinentes un petit _:plusser: fait toujours plaisir pour les contributeurs
01/05/2023, 04h38
INFINITY100

Citation:

Envoyé par Valtrase

Salut,
Si tu as trouvé des réponses pertinentes un petit _:plusser: fait toujours plaisir pour les contributeurs

c fait ;)