copier des plages variables de plusieurs feuilles vers une seule

**irene15** · 20/06/2007, 13h38

bonjour,
débutatnte en VBA, j'aimerais que vous m'aidiez a comprendre mon erreur.

ce que je cherche a faire: copier des colonnes venant de différentes feuilles (appelées Small pro et CVIT dans le code), ces colonnes pouvant comporter du vide, et les mettre les unes a la suite des autres dans une nouvelle feuille du meme classeur (appelée frsct total).

mon code qui ne fonctionne pas:

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
Sub Macro4()
'
' Macro4 Macro
'
Dim i As Integer
Dim k As Integer
 
Sheets("fcst total").Select
Range("A2:A65536").Clear
 
Sheets("SMALL PRO & Private UPDATE").Select
For i = 2 To 65536
    If Range("Bi", Range(B, i).End(xlToRight)).Value <> "" Then
        Range(B, i).Select
        Selection.Copy
        Sheets("fcst total").Select
        Range(A, i).Select
        ActiveSheet.Paste
    Else: Range(B, i) = Range(B, i + 1)
    End If
Next i
 
Sheets("CVIT UP DATE").Select
For k = 2 To 65536
    If Range("Jk", Range(j, k).End(xlToRight)).Value <> "" Then
        Range(j, k).Select
        Selection.Copy
        Sheets("fcst total").Select
        Cells(Range("A65536").End(xlUp).Row, 1).Select
        ActiveSheet.Paste
    Else: Range(j, k) = Range(j, k + 1)
    End If
Next k
 
End Sub

Merci d'avance...

**ouskel'n'or** · 20/06/2007, 15h33

Bonjour irene N°, bienvenue sur le forum.
Si tu veux qu'on puisse lire ton code, tu dois le placer entre balise Code. Tu sélectionnes le code, 1 clic sur #, épicétou.

Pour corriger, tu as le bouton Editer en bas de ton message.
A+

**ouskel'n'or** · 20/06/2007, 15h56

Regarde bien macorrection, elle est partielle, je te laisse le soin de la terminer

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 Irene()
Dim i As Integer
Dim k As Integer
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim FL2 As Worksheet
    Set FL1 = Worksheets("SMALL PRO & Private UPDATE")
    Set FL2 = Worksheets("CVIT UP DATE")
    Set FL3 = Worksheets("fcst total")
    FL3.Range("A2:A65536").ClearContents
 
    For i = 2 To 65536 ' là je suppose que B et A sont des colonnes...
        If FL1.Range("B" & i, FL1.Range("B" & i).End(xlToRight)).Value <> "" Then
            FL1.Range("B" & i).Copy destination:=FL3.Range("A" & i)
        Else
            FL1.Range("B" & i) = FL1.Range("B" & i + 1)
            'tu vérifies, je ne comprends pas ce que tu fais
            'Pourquoi colles-tu la donnée de la ligne suivante
            'sur laquelle tu vas passer le tour suivant
            'En faisant ça tu modifies la feuille d'origine... et c'est pas bien ^^^
        End If
    Next i
    
    'Les Ranges de cette boucle restent à corriger
    For k = 2 To 65536
        'Là je ne comprends pas ce que tu testes. C'est quoi Jk ?
        'Je pourrais supposer que le pb est le même que dans la boucle précédente
        'mais dans l'expectative, je te laisse comprendre ce que j'ai fait plus haut
        'pour la correction
        If FL2.Range("Jk", FL2.Range(j, k).End(xlToRight)).Value <> "" Then
            FL2.Range(j, k).Copy destination:=FL3.Cells(FL3.Range("A65536").End(xlUp).Row, 1)
        Else
            FL2.Range(j, k) = FL2.Range(j, k + 1)
        End If
    Next k
End Sub

A+

**irene15** · 20/06/2007, 16h24

merci beaucoup pour ce début de réponse.
je n'ai pas été assez précise je pense.

en fait, j'ai pris i et k pour désigner les lignes, mais ca je crois que tu l'as compris.
Je voudrais copier la colonne B de la feuille "Small pro" dans la colonne A de la feuille frcst total. Puis, a la suite de cette copie, je voudrai coller la colonne J de la feuille CVIT. Mon problème est qu'il y a des cellules blanches dans ces colonnes et je ne veux les prendre que s'il existe des cellules non vides sur la meme ligne.

Donc dans la premiere boucle ce que je voudrai faire c'est:
pour i de 2 a 20000
s'il y a des cellules non vides sur la ligne i ,
je copie la cellule (B, i)
je sélectionne la premiere cellule vide de la colonne A de la feuille frsct total,
je colle dans cette cellule,
sinon, je passe a la cellule (B,i+1) de la feuille Small pro
et ainsi de suite jusqu'à avoir toutes les cellules de la colonne collées dans "frcst total", et même les vides qui ont qd meme des references dans les autres colonnes de la meme ligne...

A la suite de ca, ma deuxième boucle serait la meme pour l'autre feuille et le collage commencerait a la cellule suivant le collage décrit plus haut...

j'espere que c'est plus clair...

merci!

**ouskel'n'or** · 20/06/2007, 16h33

Envoyé par Tu

et ainsi de suite jusqu'à avoir toutes les cellules de la colonne collées dans "frcst total", et même les vides qui ont qd meme des references dans les autres colonnes de la meme ligne...

Si tu copies toutes les cellules, même celles qui sont vides, alors pourquoi ne pas copier la plage ?
En fait, je crois comprendre ton pb, tu ne vois pas comment arrêter la copie à la fin des données de chaque feuille... Si c'est ça, tu dis
A+

**irene15** · 20/06/2007, 16h43

oui c'est ca!
et je ne sais pas non plus comment coller une autre plage qui vient donc d'une autre feuille, juste a la suite...

**irene15** · 20/06/2007, 16h45

ah, et il y a aussi une autre condition:
si la cellule que je veux copier est vide mais que des cellules de la meme ligne sont remplies, je veux bien d'une cellule vide,
sinon, je ne veux pas de cette cellule.

...

**ouskel'n'or** · 20/06/2007, 17h32

Comme tu copies toutes les lignes sauf celles qui sont entièrement vides, tu n'as qu'à tester si la ligne n'est pas vide.

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
Sub Irene()
Dim i As Integer
Dim k As Integer
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim FL2 As Worksheet
Dim derniereligne as long
    Set FL1 = Worksheets("SMALL PRO & Private UPDATE")
    Set FL2 = Worksheets("CVIT UP DATE")
    Set FL3 = Worksheets("fcst total")
    FL3.Range("A2:A65536").ClearContents
 
    DerniereLigne = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
    For i = 2 To DerniereLigne
         'Je me contente de vérifier si la ligne n'est pas entièrement vide
        If Not (FL1.Range("IV" & i).End(xlToLeft).Column = 1 And FL1.Range("A" & i) = "") Then _
            FL1.Range("B" & i).Copy destination:=FL3.Range("A" & i)
    Next i
 
    DerniereLigne = FL2.Range("A1").SpecialCells(xlCellTypeLastCell).Row
    For k = 2 To 65536
        If Not (FL2.Range("IV" & i).End(xlToLeft).Column = 1 And FL2.Range("A" & i) = "") Then _
            FL2.Range("J" & k).Copy destination:=FL3.Cells(FL3.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 1)
        End If
    Next k
End Sub

Evidemment, je n'ai pas testé

Tu fais ça pour moi ?
A+

**irene15** · 20/06/2007, 17h55

bon alors j'ai testé et il y a encore un pb que je n'arrive pas a resoudre.
En fait, ce programme me copie bien les bonnes cases de FL1 au bon endroit mais après il y a un message d'erreur qui s'affiche:
run-time error 13
type mismatch

et le problème se situe sur cette ligne

Code :

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

If Not (FL1.Range("IV" & i).End(xlToLeft).Column = 1 And FL1.Range("A" & i) = "") Then

que je n'arrive pas a comprendre...

bon courage a ceux qui vont m'expliquer!!!

**ouskel'n'or** · 20/06/2007, 18h06

Essaie de modifier la ligne en utilisant Value et Empty

Code :

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

1
2
If Not (FL1.Range("IV" & i).End(xlToLeft).Column = 1 And _
        FL1.Range("A" & i).value = empty) Then

Tu dis
A+

**COCONUT2** · 20/06/2007, 21h53

Puis je suggérer de bien dissocier les conditions du and par des parentheses

If Not (FL1.Range("IV" & i).End(xlToLeft).Column = 1) And
(FL1.Range("A" & i).value = empty) Then

**ouskel'n'or** · 21/06/2007, 00h22

Envoyé par COCONUT2

If Not (FL1.Range("IV" & i).End(xlToLeft).Column = 1) And
(FL1.Range("A" & i).value = empty) Then

NON !
Prends un feuille de calculs vierge, mets une ou deux données dans les lignes 1 à 5 sur plusieurs colonne, dont une avec la colonne 1 vide et teste ce code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub ExclureLesLignesVides()
Set FL1 = ActiveSheet
    For i = 1 To 5
        If Not (FL1.Range("IV" & i).End(xlToLeft).Column = 1 And _
        FL1.Range("A" & i).Value = Empty) Then
            MsgBox "Ligne " & i & " renseigné"
            Else
            MsgBox "Ligne " & i & " pas renseignée"
        End If
    Next
End Sub

Ensuite, remplace ma ligne par la tienne

**irene15** · 21/06/2007, 09h56

bonjour!
merci de vous attarder sur ma question...

j'ai réessayé en modifiant la ligne et en mettant empty a la place de ""
et en fait l'erreur vient de:

Code :

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

FL1.Range("A" & i).Value = Empty

lorsque je mets mon curseurdessus, il est écrit: empty=error 2023... (type mismatch)

c'est peut etre une erreur d'écriture mais comme je ne vois pas d'autre manière de référencer cette cellule, je ne peux pas résoudre mon problème...

**tonton fred** · 21/06/2007, 11h19

Bonjour bonjour,

Code :

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

If Not (FL1.Range("IV" & i).End(xlToLeft).Column = 1 And isempty(FL1.Range("A" & i)) Then

**COCONUT2** · 21/06/2007, 11h47

Envoyé par ouskel'n'or

NON !
Pour savoir si la ligne est vide, (......)
ne fait pas ce qu'il doit faire [/B]: n'exclure que les lignes entièrement vide.
Là tu ne copies que les lignes dont la dernière colonne n'est pas la colonne 1 et dont la cellule de la colonne 1 est vide.

COCONUT2, je te laisse lire ce message. Tu devrais supprimer le tien ou l'éditer pour le corriger.
J'effacerai ce message ensuite.

A+

Bonjour à tous

Effectivement, je n'ai pas fait attention au NOT.
Merci Ouskel'n'or pour cette correction

J'ai testé ton code et j'apprends beaucoup de choses sur ce forum et sur le site.

Merci encore.

**ouskel'n'or** · 21/06/2007, 11h54

Envoyé par tonton fred

Bonjour bonjour,

Code :

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

If Not (FL1.Range("IV" & i).End(xlToLeft).Column = 1 And isempty(FL1.Range("A" & i)) Then

J'espère que cette syntaxe fonctionnera car sinon je ne vois pas, à moins qu'il y ait des cellules fusionnées (?)

ou que i = 0

pourtant, la solution est la bonne pour écarter les lignes vides

Peut-être le .value est-il à supprimer dans mon code (?)
Tu as testé le code de l'oncle fred ?
A+

**irene15** · 21/06/2007, 13h33

alors là, avec le code de tonton fred, il y a un truc bizarre... dès que les cellules de FL1 sont bien copiées, une fenêtre s'ouvre intitulée file not found... où il y a tous les dossiers de mes documents...et on ne peut plus rien faire sur excel...impossible de fermer cette fenetre et impossible de retourner travailler sur le code!

c'est déjà arrivé a quelqu'un??

merci d'avance

**irene15** · 21/06/2007, 18h19

bon, finalement, j'ai changé ma réflexion et j'ai utilisé des variables et bidouillé un truc qui marche...
voila donc mon code final

merci a ceux qui se sont penchés sur mon problème...

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub copiecellules()
 
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Dim F4 As Worksheet
 
Dim nb1 As Integer
Dim nb2 As Integer
Dim nb3 As Integer
Dim nb4 As Integer
Dim nb5 As Integer
Dim nb6 As Integer
 
Set F1 = Sheets("SP")
Set F2 = Sheets("fcst total")
Set F3 = Sheets("CVIT")
Set F4 = Sheets("PM")
 
F2.Select
Range("A2:A65536").Clear
Range("B2:B65536").Clear
Range("C2:A65536").Clear
Range("D2:B65536").Clear
Range("E2:A65536").Clear
Range("F2:B65536").Clear
 
F1.Select
 
nb1 = Cells(2, 2).End(xlDown).Row
MsgBox (nb1)
 
Range(Cells(nb1, 100), Cells(2, 1)).Select
    Selection.Replace What:="", Replacement:="-", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False
 
    Range(Cells(nb1, 2), Cells(2, 2)).Copy _
    Destination:=F2.Range("A2")
    Range(Cells(nb1, 8), Cells(2, 8)).Copy _
    Destination:=F2.Range("B2")
    Range(Cells(nb1, 4), Cells(2, 4)).Copy _
    Destination:=F2.Range("C2")
    Range(Cells(nb1, 5), Cells(2, 5)).Copy _
    Destination:=F2.Range("D2")
    Range(Cells(nb1, 9), Cells(2, 9)).Copy _
    Destination:=F2.Range("F2")
 
    Range(Cells(nb1, 29), Cells(2, 29)).Select
    Selection.Copy
    F2.Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
 
 
nb2 = nb1 + 1
MsgBox (nb2)
 
F3.Select
 
nb3 = Cells(2, 2).End(xlDown).Row
 
Range(Cells(nb3, 100), Cells(2, 1)).Select
    Selection.Replace What:="", Replacement:="-", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False
 
    Range(Cells(nb3, 10), Cells(2, 10)).Copy _
    Destination:=F2.Range("A" & nb2)
    Range(Cells(nb3, 1), Cells(2, 1)).Copy _
    Destination:=F2.Range("B" & nb2)
    Range(Cells(nb3, 3), Cells(2, 3)).Copy _
    Destination:=F2.Range("C" & nb2)
    Range(Cells(nb3, 2), Cells(2, 2)).Copy _
    Destination:=F2.Range("D" & nb2)
    Range(Cells(nb3, 79), Cells(2, 79)).Copy _
    Destination:=F2.Range("F" & nb2)
 
    Range(Cells(nb3, 18), Cells(2, 18)).Select
    Selection.Copy
    F2.Select
    Range("E" & nb2).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
 
 
nb5 = nb1 + nb3
 
F4.Select
 
nb4 = Cells(2, 2).End(xlDown).Row
 
Range(Cells(nb4, 100), Cells(2, 1)).Select
    Selection.Replace What:="", Replacement:="-", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False
 
Range(Cells(nb4, 10), Cells(2, 10)).Copy _
    Destination:=F2.Range("A" & nb5)
    Range(Cells(nb4, 1), Cells(2, 1)).Copy _
    Destination:=F2.Range("B" & nb5)
    Range(Cells(nb4, 3), Cells(2, 3)).Copy _
    Destination:=F2.Range("C" & nb5)
    Range(Cells(nb4, 2), Cells(2, 2)).Copy _
    Destination:=F2.Range("D" & nb5)
    Range(Cells(nb4, 79), Cells(2, 79)).Copy _
    Destination:=F2.Range("F" & nb5)
 
    Range(Cells(nb4, 18), Cells(2, 18)).Select
    Selection.Copy
    F2.Select
    Range("E" & nb5).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
 
End Sub

**ouskel'n'or** · 21/06/2007, 19h42

Tu as essayé ce que j'ai mis là ?

**irene15** · 22/06/2007, 13h44

oui et ca fonctionnait...

copier des plages variables de plusieurs feuilles vers une seule

Macros et VBA Excel

Discussions similaires

Partager

Partager