[VBA-E]:copier entre deux tableaux sur deux classeurs

Version imprimable

Voir 40 message(s) de cette discussion en une page

23/06/2006, 10h53
VBBBA

[VBA-E]:copier entre deux tableaux sur deux classeurs

bonjour a tous.j'ai besoin d'aide sur une macro sur excel

J’ai 2 tableaux sur deux classeurs différents.
Je souhaite envoyer les infos du premier tableau sur le deuxième.
Je suis entrain de faire une macro qui prend chaque ligne du premier tableau.voit si le titre de cette ligne existe dans le deuxième tableau. Si c’est le cas alors la macro doit tronsposer les données de certaines cellules de cette ligne vers certaines cellules de la ligne trouvée au deuxième tableau.
Plus je pérsisite a trouver la solution et plus je m’embrouille l’esprit.
Alors toute aide de votre part me sera d’un grand secours.
Merci d’avance

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 copie()
 
Range("B2").Select
Selection.CurrentRegion.Select
 
 
 
 
Workbooks("copie de cashSA.xls").Sheets("Summary").Activate
Range("D12").Select
Selection.CurrentRegion.Select
 
' variable parcourant les enregistrements du premier tableau
Dim i As Double
' pour le second tableau
Dim J As Double
 i = 2
 
 
 Workbooks("D_presentBreaks").Sheets("D_presentBreaks").Activate
 
 Do Until Cells(i, 2) = ""
 
 
 
For i = 2 To 10
 
           If Workbooks("copie de cashSA.xls").Sheets("Summary").Cells(J, 4).Value = Workbooks("D_presentBreaks").Sheets("D_presentBreaks").Cells(i, 1).Value Then
               Workbooks("copie de cashSA.xls").Sheets("Summary").Cells(J, 5).Value = Workbooks("D_presentBreaks").Sheets("D_presentBreaks").Cells(i, 2).Value
               Workbooks("copie de cashSA.xls").Sheets("Summary").Cells(J, 7).Value = Workbooks("D_presentBreaks").Sheets("D_presentBreaks").Cells(, 8).Value
 
               Workbooks("copie de cashSA.xls").Sheets("Summary").Cells(J, 8).Value = Workbooks("D_presentBreaks").Sheets("D_presentBreaks").Cells(i, 6).Value
               Workbooks("copie de cashSA.xls").Sheets("Summary").Cells(J, 10).Value = Workbooks("D_presentBreaks").Sheets("D_presentBreaks").Cells(i, 10).Value
 
               Workbooks("copie de cashSA.xls").Sheets("Summary").Cells(J, 11).Value = Workbooks("D_presentBreaks").Sheets("D_presentBreaks").Cells(i, 4).Value
               Workbooks("copie de cashSA.xls").Sheets("Summary").Cells(J, 13).Value = Workbooks("D_presentBreaks").Sheets("D_presentBreaks").Cells(i, 9).Value
 
 
 
           End If
     Next J
Next i
Loop
End Sub

voila mon pti code.
en fait je vois que je peux pas travailler sur deux classeurs actifs en meme temps.
jarrive pas en tout cas.
je vois ce qu'il fo faire mais jarrive pas a trouver la methode.
besoin d'aide.
je croi que mon code contient des betises mais je debute sur vba.
alors aidez moi.
merci please

pour simplifier l'écriture de ton code tu peu créer 2 variables pointant sur tes 2 feuilles
Code:

1 2 3 4 5 Dim f1 as WorkSheet Dim f2 as WorkSheet set f1= Workbooks("copie de cashSA.xls").Sheets("Summary") set f2 = Workbooks("D_presentBreaks").Sheets("D_presentBreaks")
ensuite pour ton test j'ai pas tout compris mais tu peu écrire:
Code:

1 2 3 4 If f1.Cells(J, 4).Value = f2.Cells(i, 1).Value Then f1.Cells(J, 5).Value = f2.Cells(i, 2).Value ....

bonjour.
apres deux nuits de galeres j'ai obtenu ceci

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
Sub copie()
 
  Dim pb As String
  Dim csa As String
 
  Dim f1 As Worksheet
  Dim f2 As Worksheet
  Set f2 = Workbooks("copie de cashSA.xls").Sheets("Summary")
  Set f1 = Workbooks("D_presentBreaks").Sheets("D_presentBreaks")
 
  Dim r1 As Range
  Dim r2 As Range
 
  f2.Activate
  Set r1 = Range("D14:D19")
 
  Dim i As Integer
  Dim j As Integer
  Dim nbcolonne As Long
 
  f1.Activate
  Range("A1").Select
  Selection.CurrentRegion.Select
  nbcolonne = Selection.Rows.Count
 
  i = 2
  j = 14
 
  For i = 2 To nbcolonne Step 1
    pb = Cells(i, 1).Value
 
    'For j = 14 To 19 Step 1
    With r1
      For Each r2 In r1
 
        f2.Activate
 
        csa = r2.Value
 
        If pb = csa Then
 
          f2.Cells(j, 5).Value = f1.Cells(i, 2).Value
          f2.Cells(j, 7).Value = f1.Cells(i, 8).Value
          f2.Cells(j, 8).Value = f1.Cells(i, 6).Value
          f2.Cells(j, 10).Value = f1.Cells(i, 10).Value
          f2.Cells(j, 11).Value = f1.Cells(i, 4).Value
          f2.Cells(j, 13).Value = f1.Cells(i, 9).Value
 
        ElseIf pb <> csa Then
 
          f2.Cells(j, 5).Value = 0
          f2.Cells(j, 7).Value = 0
          f2.Cells(j, 8).Value = 0
          f2.Cells(j, 10).Value = 0
          f2.Cells(j, 11).Value = 0
          f2.Cells(j, 13).Value = 0
 
        End If
 
      Next
 
      ' i = i + 1
      ' Loop
 
    Next i
End Sub

le but etant de prendre le titre de chaque ligne du classeur f1, de cheker si il existe dans les titres du tableau du classeur f2.
le tableau f2 est sur "D12:M20".et la colonne titre est sur D12:M20;

si le chek est ok on pren certaines valeurs de la ligne du tableau1 quon copie sur certaines cellules de la ligne du tableau 2.

et si il ya un titre du tableau 2 non trouvé dans le le tableau 2 alors on reporte O aux cellules de cette ligne.
besoin d'aide.

25/06/2006, 10h51
SfJ5Rpw8
et c'est quoi ton probléme..?

tiens un peu de code à simplifier
Code:

1 2 3 4 5 f1.Activate Range("A1").Select Selection.CurrentRegion.Select nbcolonne = Selection.Rows.Count
peu s'écrire :
Code:

1 2 nbcolonne = f1.Range("A1").CurrentRegion.Rows.Count
? bizarre quand même ton nom de variable c'est les colonnes ou les lignes que tu ve compter ..?

même chose pour
Code:

1 2 3 f2.Activate Set r1 = Range("D14:D19")
qui devient
Code:

1 2 Set r1 = f2.Range("D14:D19")
dans la mesure du possible évite les activate/select...

c'est au niveau des boucles que je bute.
je veux que la macro prend chaque titre du tableau du classeur f1
qu'elle cheke si il existe dans les titres du tableau du classeur f2
si ce titre existe alors des cellules de la ligne du tableau de f1(se reportant a la ligne du titre)soit reportés sur sur certaines cellules de la ligne de titre trouvé au tableau 2.
le resultat est que ma macro me donne que des 0 dans le tableau du classeur 2
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 for i =2 to nbcolonne 'pour chaque cellule de titre du tableau de f1 pb = Cells(i, 1).Value ' j'affecte le titre de la ligne i a la variable string pb For j = 14 To 19 Step 1 ' pour chaque cellule de la colonne titre du tableau cible qui va de D12 à D19 ' j'affecte la valeur du titre a csa ' ensuite j'utilise if : If pb = csa Then f2.Cells(j, 5).Value = f1.Cells(i, 2).Value f2.Cells(j, 7).Value = f1.Cells(i, 8).Value f2.Cells(j, 8).Value = f1.Cells(i, 6).Value f2.Cells(j, 10).Value = f1.Cells(i, 10).Value f2.Cells(j, 11).Value = f1.Cells(i, 4).Value f2.Cells(j, 13).Value = f1.Cells(i, 9).Value
je pense que c'est pas bon.
si dans le tableau cible ya des titres non trouvés dans le tableau d'origine cette lignne doit avoir des 0 sur certaines colonnes.

je suis entrain de bucher sur les tableaux....est ce une alternative?

aidez moi please

25/06/2006, 11h07
VBBBA

c'est le nombre de ligne que je veux compter en effet nbligne alors
la fatigue sans doute......
25/06/2006, 11h14
SfJ5Rpw8
eu la je sais pas trop ce que tu fais finalement :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 'For j = 14 To 19 Step 1 With r1 For Each r2 In r1 f2.Activate csa = r2.Value
.. sur quoi est tu parti pour ta boucle... et comment affecte tu sa valeur à csa..?

je l'ai refait(en effet ca colle pas)
voila le nouveau mais ca beugue toujours8O 8O

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
 
For i = 2 To nbligne Step 1
pb = Cells(i, 1).Value
 
For j = 14 To 19 Step 1
'With r1
'For Each r2 In r1
 
f2.Activate
 
   csa = Cells(j, 4).Value
 
                  If pb = csa Then
 
                     f2.Cells(j, 5).Value = f1.Cells(i, 2).Value
                     f2.Cells(j, 7).Value = f1.Cells(i, 8).Value
                     f2.Cells(j, 8).Value = f1.Cells(i, 6).Value
                     f2.Cells(j, 10).Value = f1.Cells(i, 10).Value
                     f2.Cells(j, 11).Value = f1.Cells(i, 4).Value
                     f2.Cells(j, 13).Value = f1.Cells(i, 9).Value
 
                  ElseIf pb <> csa Then
 
                     f2.Cells(j, 5).Value = 0
                     f2.Cells(j, 7).Value = 0
                     f2.Cells(j, 8).Value = 0
                     f2.Cells(j, 10).Value = 0
                     f2.Cells(j, 11).Value = 0
                     f2.Cells(j, 13).Value = 0
 
                End If
 
   Next j
   Next i

donc j'ai raisonné comme suit
pour chaque cellule de titre du tableau de f1, on pren les cellules de titre du tableau cible.
si un de ces titres est egal a au titre considéré on affecte certaines cellules de la ligne de titre du tableau d'origine a la ligne de titre cible trouvé

le resultat est O partout sur le tableau cible!!!!
en utilisant le débogueur je vois que ca marche a un moment donné pour la premiere ligne cible est apres elle repasse a 0.
voila

25/06/2006, 11h27
SfJ5Rpw8

rajoute.. f1. ou f2. devant cells... :

Code:

pb = Cells(i, 1).Value

et pose toi la question :la ligne f2.activate est-elle utile dans la boucle ;)
25/06/2006, 11h38
VBBBA

en fait ce que j'ai compris c'est en bossant sur deux classeurs
on doit activer a chaque fois le classeur sur lequel on travaille....
jessai ton dernier conseil et je reviens
25/06/2006, 11h55
VBBBA
je pense que je suis pas loin mais mes boucles sont pas bonnes!!

en fait je devrais faire
Code:

1 2 3 4 For i = 2 To nbligne Step 1 pb = f1.Cells(i, 1).Value For Each Cells(j, 4) In r1
la derniere ligne n'est pas bonne.
por chaque cellule(j,4) qui fait partie de D12:D19. comment traduire ca?
25/06/2006, 12h09
SfJ5Rpw8
ta plage de cellule D14..D19 , est elle amenée à évoluer..? ..

plusieurs solutions ... tu peu utiliser une boucle for J...
Code:

1 2 3 4 5 6 7 ... For j = 14 to 19 csa = f2.Cells(j, 4).Value ... Next ...
si tu ve utiliser un For Each ... ne te limite pas à une colonne et définit plutôt ta plage compléte..
Code:

1 2 3 4 5 6 7 8 9 10 .. set R1=f2.range("A14:M19") ... For each r2 in r1. rows ' Parcours des lignes de la plage csa = r2.Cells(4) ... R2.cells(5) = f1.Cells(i, 2).Value ... next

voila c que jobtien avec for each

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
46
47
48
49
50
51
52
53
 
 
Sub copie()
 
Dim f1 As Worksheet
Dim f2 As Worksheet
Set f2 = Workbooks("copie de cashSA.xls").Sheets("Summary")
Set f1 = Workbooks("D_presentBreaks").Sheets("D_presentBreaks")
 
Dim r1 As Range, r2 As Range
 
Dim celr1 As Range, celr2 As Range
 
 
Set r1 = f1.Range("A2").CurrentRegion
 
Set r2 = f2.Range("D14:D19")
 
For Each clr1 In r1
 
 
  For Each celr2 In r2
 
 
      If celr2.Value = celr1.Value Then   'ici ca beugue
 
           celr2.Offset(0, 1).Value = celr1.Offset(O, 1).Value
           celr2.Offset(0, 1).Value = celr1.Offset(O, 1).Value
           celr2.Offset(0, 3).Value = celr1.Offset(O, 7).Value
           celr2.Offset(0, 4).Value = celr1.Offset(O, 5).Value
           celr2.Offset(0, 6).Value = celr1.Offset(O, 9).Value
           celr2.Offset(0, 7).Value = celr1.Offset(O, 3).Value
           celr2.Offset(0, 9).Value = celr1.Offset(O, 8).Value
 
      If celr2 <> celr1 Then
 
 
           celr2.Offset(0, 1).Value = 0
           celr2.Offset(0, 3).Value = 0
           celr2.Offset(0, 4).Value = 0
           celr2.Offset(0, 6).Value = 0
           celr2.Offset(0, 7).Value = 0
           celr2.Offset(0, 9).Value = 0
 
 
  Exit For
      End If
      End If
 
    Next 'celr2
Next 'celr1
 
End Sub

je sens que je suis pas loin dutout.
non??

25/06/2006, 12h53
SfJ5Rpw8

avec ces for Each tu parcours toutes les cellules de ta plage... regarde ce que je t'ai écrit plus haut pour parcourir les Lignes de ta plage...;)
25/06/2006, 12h56
VBBBA

:aie: :aie: :aie: :aie: :aie: :aie:
25/06/2006, 13h01
SfJ5Rpw8

Citation:

Envoyé par VBBBA

:aie: :aie: :aie: :aie: :aie: :aie:

?

Code:

For each r2 in r1.rows

?
25/06/2006, 13h08
VBBBA

pourquoi ca bloque a ce niveau a ton avis?

If celr2.Value = celr1.Value Then
25/06/2006, 13h15
SfJ5Rpw8

cela dépend de ton for Each...mais si tu parcours des lignes celr2 .. est une ligne... utilise celr2.cells(4) ... pour par exemple à accéder à la 4° cellule de la ligne...

l'erreur est: variable objet ou variable de bloc with non défini
pourtant jutilise pas de bloc with!!!!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Dim f1 As Worksheet
Dim f2 As Worksheet
Set f2 = Workbooks("copie de cashSA.xls").Sheets("Summary")
Set f1 = Workbooks("D_presentBreaks").Sheets("D_presentBreaks")
 
Dim r1 As Range, r2 As Range
 
Dim celr1 As Range, celr2 As Range
 
 
Set r1 = f1.Range("A2").CurrentRegion
 
Set r2 = f2.Range("D14:D19")
 
For Each clr1 In r1.Rows
    For Each celr2 In r2.Rows
      If celr2.Value = celr1.Value Then

fronchement je ne vois pas la.....

Voir 40 message(s) de cette discussion en une page