import de données de plusieurs feuilles dans une seule

**naevus** · 12/12/2007, 15h46

Salut,

J'aimerais une macro qui me permetterai de lire des données dans plusieurs feuilles et de les importées dans une. Dans les feuilles, j'ai des données sur 6 colonnes avec une colonne entre chaques et la première est vide. Pour les lignes, les données sont sur les 4 premières lignes ensuite une ligne vide, et de nouveau 4 lignes, ainsi de suite j'usqu'a la ligne 35.
Pour l'importation, j'aimerais que dans la feuille 2, la cellule B1 aille dans la feuille 1, cellule A2, que la cellule B2 de la feuiile 2 aille dans la cellule B2 de la feuille 1, que la cellule B3 de la feuiile 2 aille dans la cellule C2 de la feuille 1, que la cellule B4 de la feuiile 2 aille dans la cellule D2 de la feuille 1. Ensuite ca prend les données suivantes sur la colonne, et une fois en bas de la colonne, ca va copier les valeurs de la deuxieme colone, puis de la troisieme etc..

Je suis un peu long, désolé.

Quelqu'un a-t'il une solution ?

Merci

**Jean-Philippe André** · 12/12/2007, 16h14

salut naevus,
bienvenue sur DVP déjà

ton problème semble complexe, donc ne t'attend pas à recevoir un bout de code tout fait comme ca.
On va procéder par ordre :
- as-tu des notions de VBA ?
- as-tu commencé à faire une macro ?
- si oui, où commences-tu à peiner dans ton cheminement vers la solution ?

Plein de tutos à ta disposition, des gens prêts à t'aider pour aboutir à un résultat, mais pas de personnes qui "font à ta place"

Dis nous tout

**gedechp** · 12/12/2007, 17h48

bonjour
si j'ai bien compris la premiere partie semble simple

a partir de feuille2 sur feuille1
copier la valeur de B1 en A2
copier la valeur de B2 en B2
copier la valeur de B3 en C2
copier la valeur de B4 en D2

c'est apres ton ensuite que je ne comprends plus ce que tu veux faire

pour la premiere partie ce petit bout de code semble faire l'affaire

Code :

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

1
2
3
4
5
6
Sub recopie()
Dim i As Integer
For i = 0 To 3
    Worksheets("feuil1").Range("A2").Offset(0, i).Value = Worksheets("feuil2").Range("B" & i + 1).Value
Next i
End Sub

si tu rencontre des difficultés pour la suite explique

cordialement
GERARD

**Qwazerty** · 12/12/2007, 17h58

SAlut
As tu vraiment besoin du vba pour faire ca des formules Excel ne resoudraient elle pas ton probleme ?

[Edit]
Pour le ensuite j'essais de prolonger la serie donnée par gedechp
copier la valeur de B1 en A2
copier la valeur de B2 en B2
copier la valeur de B3 en C2
copier la valeur de B4 en D2
copier la valeur de B5 en A3
copier la valeur de B6 en B3
...
[/Edit]
A++
Qwaz

**naevus** · 13/12/2007, 08h14

Je suis un nouvel utilisateur de vba, j'ai quelques notions de bases. J'ai essayer de faire un programme avec des options explicit et tout le toutim... mais je dois avouer que pour le moment mes compétences sont encore trop légère.

gedechp : C'est bien ca au début, pour essayer d'être plus explicite, il faut que ca continue sur les autres lignes et les autres colonnes, puis la même choses sur les autres pages. Mais la je reprend le code et je change le nom de la feuille. Je vais essayer de me pencher dessus.

Qwazerty : Je pense que vba est la meilleur solution car mes feuiiles peuvent évoluer et il peut y en avoir des autres.

En fait c'est pour gérer ma collection de pièces. Dans les feuilles, j'ai mis en forme les feuilles pour être rangé dans des classeurs, et la première est pour récapituler le tout.

Merci encore pour tout.

N@evus

J'ai recopier les lignes :

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
Sub recopie()
Dim i As Integer
For i = 0 To 3
    Worksheets("feuil1").Range("A2").Offset(0, i).Value = Worksheets("1ct").Range("B" & i + 1).Value
Next i
For i = 0 To 3
    Worksheets("feuil1").Range("A3").Offset(0, i).Value = Worksheets("1ct").Range("D" & i + 1).Value
Next i
For i = 0 To 3
    Worksheets("feuil1").Range("A4").Offset(0, i).Value = Worksheets("1ct").Range("F" & i + 1).Value
Next i
For i = 0 To 3
    Worksheets("feuil1").Range("A5").Offset(0, i).Value = Worksheets("1ct").Range("H" & i + 1).Value
Next i
For i = 0 To 3
    Worksheets("feuil1").Range("A6").Offset(0, i).Value = Worksheets("1ct").Range("J" & i + 1).Value
Next i
For i = 0 To 3
    Worksheets("feuil1").Range("A7").Offset(0, i).Value = Worksheets("1ct").Range("L" & i + 1).Value
Next i
For i = 0 To 3
    Worksheets("feuil1").Range("A8").Offset(0, i).Value = Worksheets("1ct").Range("B" & i + 6).Value
Next i
For i = 0 To 3
    Worksheets("feuil1").Range("A9").Offset(0, i).Value = Worksheets("1ct").Range("D" & i + 6).Value
Next i
End Sub

etc...

Le problème c'est que j'ai au moins 600 lignes à faire. que dois-je utiliser pour faire répeter ?

**LeForestier** · 13/12/2007, 09h53

Bonjour,
Déjà une petite idée pour simplifier..

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub recopie()
Dim i As Integer, X As Integer
Dim V As Integer, TB() As String
    TB = Array("0", "0", "B", "D", "F", "H", "J", "L", "B", "D")
    X = 1
    For V = 2 To 9
        If V > 7 Then X = 6
        For i = 0 To 3
            Worksheets("feuil1").Cells(V, i) = Worksheets("1ct").Range(TB(V) & i + X).Value
        Next i
    Next V
End Sub

A+
PS:quand tu met du code dans ton poste tu doit le baliser ...
Sélectionner le texte du code et clic sur # dans la barre d'outils de l'éditeur.

**Qwazerty** · 13/12/2007, 18h32

SAlut
Voila une autre idée de simplification, faute de données je n'est pas testé

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
 
Dim IntCol As Integer
Dim IncRow1 As Integer, IncRow2 As Integer
Dim VarTmp As Variant
 
 
'Init
IncRow = 2
 
Do
    For IntCol = 2 To 12 Step 2
        VarTmp = Worksheets("1ct").Cells(IncRow2, IntCol).Value
        If CStr(VarTmp) = "" Then Exit Do
        Worksheets("feuil1").Cells(IncRow1, "A").Value = VarTmp
        IncRow = IncRow + 1
    Next IntVar2
    IncRow2 = IncRow2 + 5
Loop

Pour sortir de la boucle j'ai supposé que tu avais toujours des champs rempli et que i un champs etait vide c'est que l'on ete arrivé a la fin de ta collection
A++
Qwaz

**naevus** · 18/12/2007, 16h35

Voila ce que j'ai pondu :

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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
Option Explicit
Dim L As Integer
Dim C As Integer
Dim L2 As Integer
Dim C2 As Integer
Dim PremL1 As Integer
Dim Ligne1 As Integer
Dim PremC1 As Integer
Dim Col1 As Integer
Dim PremL2 As Integer
Dim PremC2 As Integer
Dim Ligne2 As Integer
Dim Valeur
Dim LBloc As Integer
Dim P1 As String
Dim P2 As String
Dim P3 As String
Dim P4 As String
Dim P5 As String
Dim P6 As String
Dim P7 As String
Dim P8 As String
Dim P9 As String
Dim P10 As String
Dim P11 As String
Dim P12 As String
Dim P13 As String
Dim P14 As String
Dim P15 As String
Dim Sortie As Boolean
Dim DepBloc As Integer
 
 
Private Sub Initialisation()
 LBloc = 4
 P1 = "1ct": P2 = "Récapitulatif" 'Feuil1 lecture et Feuil2 ecriture
 P3 = "1ct-2cts-5cts"
 P4 = "5cts"
 P5 = "5cts-10cts"
 P6 = "10cts-20cts"
 P7 = "20cts-50cts"
 P8 = "50cts-1fr"
 P9 = "1Fr"
 P10 = "1Frs-2Frs5frs"
 P11 = "5Frs"
 P12 = "5Frs-10Frs"
 P13 = "10Frs"
 P14 = "10Frs (2)"
 P15 = "10Frs (3)"
 PremL1 = 1
 PremC1 = 2
 PremL2 = 2
 PremC2 = 1
 
End Sub
Public Sub Copie_mise_en_forme_ligne()
 'feuille 1ct
 
 Call Initialisation
 Sortie = False
 L = PremL1: C = PremC1
 While Not Sortie
  If ThisWorkbook.Worksheets(P1).Cells(L, C) = "" And ThisWorkbook.Worksheets(P1).Cells(L + 1, C) = "" Then
   Ligne1 = L - 1
   Sortie = True
  End If
  L = L + 1
 Wend
 L = PremL1: Sortie = False
 While Not Sortie
  If ThisWorkbook.Worksheets(P1).Cells(L, C) = "" And ThisWorkbook.Worksheets(P1).Cells(L, C + 1) = "" Then
   Col1 = C - 1
   Sortie = True
  End If
  C = C + 1
 Wend
 L2 = PremL2: C2 = PremC2
 L = PremL1: C = PremC1
 DepBloc = PremL1
 While L <= Ligne1 + 1
  Valeur = ThisWorkbook.Worksheets(P1).Cells(L, C)
  If Valeur <> "" Then
   ThisWorkbook.Worksheets(P2).Cells(L2, C2) = Valeur
   L = L + 1
   C2 = C2 + 1
  Else
   If C >= Col1 Then
    C = PremC1
    L = L + 1
    DepBloc = L
   Else
    L = DepBloc
    C = C + 2
   End If
   L2 = L2 + 1
   C2 = PremC2
  End If
 Wend
 
'feuille 1ct-2cts-5cts--------------------------------------------------------------------
 
 While Not Sortie
  If ThisWorkbook.Worksheets(P3).Cells(L, C) = "" And ThisWorkbook.Worksheets(P3).Cells(L + 1, C) = "" Then
   Ligne1 = L - 1
   Sortie = True
  End If
  L = L + 1
 Wend
 L = PremL1: Sortie = False
 While Not Sortie
  If ThisWorkbook.Worksheets(P3).Cells(L, C) = "" And ThisWorkbook.Worksheets(P3).Cells(L, C + 1) = "" Then
   Col1 = C - 1
   Sortie = True
  End If
  C = C + 1
 Wend
' L2 = PremL2: C2 = PremC2
' L = PremL1: C = PremC1
' DepBloc = PremL1
 While L <= Ligne1 + 1
  Valeur = ThisWorkbook.Worksheets(P3).Cells(L, C)
  If Valeur <> "" Then
   ThisWorkbook.Worksheets(P2).Cells(L2, C2) = Valeur
   L = L + 1
   C2 = C2 + 1
  Else
   If C >= Col1 Then
    C = PremC1
    L = L + 1
    DepBloc = L
   Else
    L = DepBloc
    C = C + 2
   End If
   L2 = L2 + 1
   C2 = PremC2
  End If
 Wend
 
'feuille 5cts--------------------------------------------------------------------------
 
 
 While Not Sortie
  If ThisWorkbook.Worksheets(P4).Cells(L, C) = "" And ThisWorkbook.Worksheets(P4).Cells(L, C) = "" Then
'   Ligne1 = L
   Sortie = True
  End If
'  L = L + 1
 Wend
 L = PremL1: Sortie = False
 While Not Sortie
  If ThisWorkbook.Worksheets(P4).Cells(L, C) = "" And ThisWorkbook.Worksheets(P4).Cells(L, C + 1) = "" Then
   Col1 = C - 1
   Sortie = True
  End If
  C = C + 1
 Wend
' L2 = PremL2: C2 = PremC2
' L = PremL1: C = PremC1
' DepBloc = PremL1
 While L <= Ligne1 + 1
  Valeur = ThisWorkbook.Worksheets(P4).Cells(L, C)
  If Valeur <> "" Then
   ThisWorkbook.Worksheets(P2).Cells(L2, C2) = Valeur
   L = L + 1
   C2 = C2 + 1
  Else
   If C >= Col1 Then
    C = PremC1
    L = L + 1
    DepBloc = L
   Else
    L = DepBloc
    C = C + 2
   End If
   L2 = L2 + 1
   C2 = PremC2
  End If
 Wend
 
End Sub

Par contre, je dois avoir une erreur, je n'arrive pas a le faire sur les autres pages. je ne comprend pas.

A+

N@evus

PS : Merci leforestier, c'est plus clair comme ca...

**Qwazerty** · 19/12/2007, 19h12

SAlut
Bon désolé de le dire comme ca, mais ta macro est d'un compliquer pour faire pas grand chose.
Donne carrement le fichier par ce que sans avoir la position des valeurs c'est pas facil du tout a suivre, et pour t'aider efficacement il faut qu'on puisse tester les codes qu'on te propose, si tu ne veux pas balancer tes fichiers originaux ce que je peux parfaitement comprendre, fait une copie de quelque onglets et mets des valeur bidons.

Quelques remarques sur ton code
En ce qui concerne l'initialisation, je dirais que trop de variables tuent les variables, au lieu de créer un variable string avec le nom de ton onglet, tu peux créer carrement un variable Objet contenant la reference a ton onglet (je sais que c'est du charabia mais quand on debut faut aussi prendre le temps de regarder un peu le code des autre gens qui traine sur le forum).

Il existe des fonctions en vba permettant de retrouver la derniere cellule non vide d'une ligne ou d'une colonne, inutile de faire des boucles pour ca (j'ai bien compris que tu recherches 2 cellules vides de suite pour etre sur d'etre a la fin de ton tableau).

Je comprend que tu debuts mais differentes solutions t'ont etes proposées (ca marche pas ? pourquoi ?), mais tu n'as pas vraiment l'aire d'en tenir compte malgrés ce que tu dis dans tes topics, je ne retrouve null part la trame du code qu'a donné LeForestier par exemple).

J'espere que tu ne prendra pas mal mes reflections mais je pense qu'il fallait que ce soit dis pour partir sur des bases saines

En l'attente de ton fichier.

A++
Qwaz

**naevus** · 07/01/2008, 13h32

Bonne année a tous

Qwaz, j'ai bien essayé les codes fournit, je n'ai pas développer, désolé

.
En fait sur ces codes je n'avais que des erreurs d'executions, alors je suis passé à autre chose.

Je te joint donc mon fichier.

A+

Naevus

**patbou** · 07/01/2008, 14h13

bonjour,

pour alimenter la 2 eme feuil tu peux simplifier ton code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub recopie()
Dim i As Integer
For i = 0 To 3
    Worksheets("feuil1").Range("A2").Offset(0, i).Value = Worksheets("1ct").Range("B" & i + 1).Value
Next i
For i = 0 To 3
    Worksheets("feuil1").Range("A3").Offset(0, i).Value = Worksheets("1ct").Range("D" & i + 1).Value
Next i
For i = 0 To 3
    Worksheets("feuil1").Range("A4").Offset(0, i).Value = Worksheets("1ct").Range("F" & i + 1).Value
Next i

avec 2 boucles si la structure est toujours la meme

Code :

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

1
2
3
4
5
6
7
8
9
10
 
dim fl1 as worksheet
dim fl2 as worksheet
set fl1 = Worksheets("feuil1")
set fl2 =Worksheets("1ct")
     for j = 0 to 600 ' apparement tu as 600 lignes a reporter
          for i = 0 to 3
               fl1.cells(j+2,i).value = fl2.cells(i,j*2).value
          next i
     next j

**Qwazerty** · 07/01/2008, 18h43

SAlut
Alors bon tu as pas integré grand chose a ton code des conseil qui ton etaient apportés.
Voila comment je resoudrais ton probleme

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
Sub essai()
Dim I As Integer, J As Integer, K As Integer
Dim SourceOnglet As Variant
 
For Each SourceOnglet In Array("1ct", "1ct-2cts-5cts", "5cts", "5cts-10cts", "10cts-20cts", "20cts-50cts") 'etc
    With ThisWorkbook.Worksheets(CStr(SourceOnglet))
        For I = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column Step 2 'on saute les colonne de 2 en 2
            For J = 1 To .Cells(Rows.Count, "B").End(xlUp).Row Step 5 'on saute les case de 5 en 5 en descendant
                ThisWorkbook.Worksheets("Récapitulatif").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = .Cells(J, I)
                For K = 1 To 4
                    ThisWorkbook.Worksheets("Récapitulatif").Cells(Rows.Count, "A").End(xlUp).Offset(0, K).Value = .Cells(J, I).Offset(K, 0)
                Next
            Next
        Next
    End With
Next
End Sub

Dans le Array de la boucle For Each tu doit mettre la liste des page a traiter
J'ai lancer ma macro et je pense qu'elle s'attisfait a ton besoin
A++
Qwaz

**naevus** · 10/01/2008, 13h25

Je voulais vous remercier pour votre aide, j'ai du apporter deux trois modifs. Une pour effacer la feuille à chaque mise à jour, car le programme remplissait au bout à bout. Et il ne prennait pas dans le bon ordre. Mais maintenant je vais pouvoir faire des mises à jour dans mes feuilles.

Merci encore pour tout

N@evus

**naevus** · 10/01/2008, 13h32

Qwaz, merci pour ton aide.

_______________________

Score powerball 12363

import de données de plusieurs feuilles dans une seule

Macros et VBA Excel

Discussions similaires

Partager

Partager