Discussion :

[JiBé91]

Bonjour à tous,

comme vous l'avez peut etre lu dans ma présentation je débute en VBA. Et comme de bien entendu, comme tout débutant je souhaite mettre la charue avant les boeufs...

Bref, j'ai réussis a faire ce que je voulais avec ma macro d'une façon plus ou moins orthodoxe. Toutefois, j'aimerais que cette macros s'applique sur plusieurs cellules non contigues.

Voici la macro:
Définition: elle copie dans un autre classeurs les cellules spécifié d'une ligne si une des cellules de cette ligne n'est pas renseignée.

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
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub COPIEDONNEES()
Dim NomFichierEntree
Dim Sortie As Workbook
Dim Entree As Workbook
Dim FeuilleOrigine As Worksheet
Dim FeuilleDestination As Worksheet
 
    Set Sortie = ThisWorkbook
 
    If IsEmpty(Range("D1")) Then
 
        ' On ouvre le classeur
        Set Entree = Workbooks.Open("C:\Documents and Settings\user\Bureau\Travaux excel\Appro matiere.xlsx")
 
        'Référence feuille origine des données à copier
        Set FeuilleOrigine = Entree.Sheets("Feuil1")
 
        'Référence la feuille de destination des cellules copiées
        Set FeuilleDestination = Sortie.Sheets("Feuil1")
 
        'on insert un ligne
 
        Rows("2").Insert Shift:=xlDown
 
        ' On copie les cellules vers la feuille de sortie depuis la feuille désirée
        FeuilleOrigine.Range("A2").Value = FeuilleDestination.Range("A4").Value
        FeuilleOrigine.Range("B2").Value = FeuilleDestination.Range("B4").Value
        FeuilleOrigine.Range("C2").Value = FeuilleDestination.Range("C4").Value
 
        ' On ferme le classeur
        Workbooks("Appro matiere.xlsx").Save
        Entree.Close
 
    End If
 
End Sub

Je souhaiterai appliquer ce code aux cellules D3; D5; etc...

Je n'arrive pas a trouver quoi que ce soit la dessus ou ne comprends pas ce que je trouve.

Si possible je cherche un peu plus qu'une réponse, une explication

Merci pour le temps que vous me consacrerez

Cordialement

[Philippe Tulliez]

Bonjour,
Je ne sais pas si c'est une réponse à ta question mais voici une procédure avec 2 cas traitant de cellules non contigües.

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
Sub SelectionNonContigue()
 Dim wkb As Workbook, sht As Worksheet, rng As Range
 Dim cel As Range, celCopy As Range
 Dim count As Byte: count = 2
 Set wkb = ThisWorkbook: Set sht = wkb.Worksheets("Test")
 Set rng = sht.Range("A2:C3,A5:C5,A8:C8")
 ' Cas N°1 - Copie des cellules non contigües vers la cellule G2 de la même feuille
 rng.Copy sht.Range("G2")
 ' Cas N°2 - Parcoure toutes les éléments de la plage de cellules non contigües
 '           Test si la valeur des cellules de la colonne 2 de la plage est supérieure à 3
 '           Dans l'affirmative copie vers la colonne K de la même feuille
 For Each cel In rng
  If cel.Column = 2 And cel > 3 Then ' Test si la valeur de la colonne 2 est > 3
   Set celCopy = sht.Range(cel.Offset(0, -1), cel.Offset(0, 1))
   celCopy.Copy sht.Range("K" & count): count = count + 1
  End If
 Next
End Sub

[mercatog]

Un exemple légèrement commenté à adapter à ton contexte

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
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Main()
Dim i As Long
Dim Entree As Workbook
Const Fichier As String = "C:\Documents and Settings\user\Bureau\Travaux excel\Appro matiere.xlsx"
 
Application.ScreenUpdating = False
If Dir(Fichier) <> "" Then                       'verifier que le fichier existe bel et bien
 
    Set Entree = Workbooks.Open(Fichier)         'on ouvre le fichier Appro matiere.xlsx
    With ThisWorkbook.Worksheets("Feuil1")
        For i = 1 To 19 Step 2                   'on parcourt toutes les cellules de notre plage D1,D3...D19 (Adapte le 19 à ta plage)
            COPIEDONNEES Entree, .Range("D" & i)
        Next i
    End With
    Entree.Close True                            'On ferme le fichier Appro matiere.xlsx en enregistrant les modifications
    Set Entree = Nothing                         'on libère la variable Entree
End If
End Sub
 
'Sous procédure paramétrée qui permet de copier les 3 données vers Feuil1 du classeur Wbk
'Si c=D1 on insère une ligne à la place de ligne 2 et on y copies les cellules A2:B2 et C2 respectivement
'l'offset désigne 1 lignes en bas
Private Sub COPIEDONNEES(ByVal Wbk As Workbook, ByVal Cellule As Range)
 
If IsEmpty(Cellule) Then
    With Wbk.Worksheets("Feuil1")
        .Rows(2).Insert Shift:=xlDown
        .Range("A2:C2").Value = Cellule.Offset(1, 0).Resize(1, 3).Value
    End With
End If
End Sub

[JiBé91]

Merci pour vos réponses.

alors, ai je bien compris la fonction suivante:

Code :

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

1
2
For i = 1 To 19 Step 2                   
            COPIEDONNEES Entree, .Range("D" & i)

Pour une cellule sur deux de la colonne D entre les lignes 1 et 19 c'est bien ça?



Mercatog, comment dois je intégrer ce que tu m'as écris? Dois je le metre dans un autre module?

[mercatog]

Fais le tout dans un module et appelle la procédure Main

[JiBé91]

je bloque...

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
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
46
47
48
49
50
51
52
53
54
55
Sub Main()
Dim i As Long
Dim Entree As Workbook
Const Fichier As String = "C:\Documents and Settings\user\Bureau\Travaux excel\Appro matiere.xlsx"
 
Application.ScreenUpdating = False
If Dir(Fichier) <> "" Then                       'verifier que le fichier existe bel et bien
 
    Set Entree = Workbooks.Open(Fichier)         'on ouvre le fichier Appro matiere.xlsx
    With ThisWorkbook.Worksheets("Feuil1")
        For i = 1 To 19 Step 2                   'on parcourt toutes les cellules de notre plage D1,D3...D19 (Adapte le 19 à ta plage)
            COPIEDONNEES Entree, .Range("D" & i)
        Next i
    End With
    Entree.Close True                            'On ferme le fichier Appro matiere.xlsx en enregistrant les modifications
    Set Entree = Nothing                         'on libère la variable Entree
End If
End Sub
 
Sub COPIEDONNEES()
Dim NomFichierEntree
Dim Sortie As Workbook
Dim Entree As Workbook
Dim FeuilleOrigine As Worksheet
Dim FeuilleDestination As Worksheet
 
    Set Sortie = ThisWorkbook
 
    If IsEmpty(Range("Di")) Then
 
        ' On ouvre le classeur
        Set Entree = Workbooks.Open("C:\Documents and Settings\user\Bureau\Travaux excel\Appro matiere.xlsx")
 
        'Référence feuille origine des données à copier
        Set FeuilleOrigine = Entree.Sheets("Feuil1")
 
        'Référence la feuille de destination des cellules copiées
        Set FeuilleDestination = Sortie.Sheets("Feuil1")
 
        'on insert un ligne
 
        Rows("2").Insert Shift:=xlDown
 
        ' On copie les cellules vers la feuille de sortie depuis la feuille désirée
        FeuilleOrigine.Range("A2").Value = FeuilleDestination.Range("A4").Value
        FeuilleOrigine.Range("B2").Value = FeuilleDestination.Range("B4").Value
        FeuilleOrigine.Range("C2").Value = FeuilleDestination.Range("C4").Value
 
        ' On ferme le classeur
        Workbooks("Appro matiere.xlsx").Save
        Entree.Close
 
    End If
 
End Sub

Voila ce que j'écris et ça bloque à la ligne 12 sur "COPIEDONNES" "Erreur de compilation, nombre d'arguments incorrect ou affectation de propriété incorrect"

[mercatog]

Je t'arrête ici sans plus!
reprenons l'explication

Si D1 est vide on insère une ligne vide à la place de la ligne 2 et on copie les données de A4, B4 et C4

Ensuite

Si D3 est est vide on insère une ligne vide à la place de la ligne 2 et on copie les données de X, Y et Z

Quelles sont les cellules X, Y et Z?