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

**VBBBA** · 23/06/2006, 10h53

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

**VBBBA** · 23/06/2006, 20h12

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
 
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

**SfJ5Rpw8** · 23/06/2006, 20h44

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

Code :

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

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 :

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

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
        ....

**VBBBA** · 25/06/2006, 10h33

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

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
 
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.

**SfJ5Rpw8** · 25/06/2006, 10h51

et c'est quoi ton probléme..?

tiens un peu de code à simplifier

Code :

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

1
2
3
4
5
 
f1.Activate
Range("A1").Select
Selection.CurrentRegion.Select
nbcolonne = Selection.Rows.Count

peu s'écrire :

Code :

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

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 :

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

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

qui devient

Code :

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

1
2
 
Set r1 = f2.Range("D14:D19")

dans la mesure du possible évite les activate/select...

**VBBBA** · 25/06/2006, 11h03

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 :

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
 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

**VBBBA** · 25/06/2006, 21h18

bonsoir.
voici mon code

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
 
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
Dim r2 As Range
Dim celr1 As Range
Dim celr2 As Range
 
Set r1 = f1.Range("A2").CurrentRegion
 
Set r2 = f2.Range("D14:D19")
 
For Each celr2 In r2
 
     For i = 2 To 5   ' Each celr1 In r1
 
        If celr2.Cells(4).Value = celr1.Cells(1).Value Then
 
           celr2.Offset(0, 1).Value = celr1.Offset(0, 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
 
        End If
 
      If celr2.Cells(4).Value <> celr1.Cells(1).Value 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
 
      End If
      Exit For
 
    Next
 
Next
 
End Sub

jai ma boucle qui narive pas a copier du tableau source de f1 au tableau de f2

le tableau source a des lignes variables.

**SfJ5Rpw8** · 25/06/2006, 22h08

j'ai fusionné tes 2 messages c'est le même sujet...?

c'est quoi cette ligne :

Code :

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

  For i = 2 To 5

ou sont les .rows ? pourquoi des offsets ?

**VBBBA** · 25/06/2006, 23h09

bonsoir jai vu que ta déconnecté alors....

ca marche pas les boucles!
ca me donne que des o a toutes mes lignes du tableau cible!!!

dés qu'un titre cible est repéré et puis que sa ligne soit complété je neveux plus qu'elle soit chekée.

voila comment je raisonne:
je pren la cellule(i,2) du tableau origine(f1), je cheke si elle existe sur la colonne titre du tableau cible(f2 placé sur D12:M19) . si elle existe alors certaines cellules de la ligne de titre du tableau origine sont reporté sur certaines cellules de la ligne de titre trouvé dans le tableau cible.

je pren ensuite la cellule(i+1,2) je fai pareil mais le chek ne doit pas prendre la ligne remplie a l'etape 1.

si un titre cible n'est pas dans les titres origines alors sa ligne doit etre a 0 partout.

et si un titre de ligne n'est pas dans la colonne titre alors un message doit etre affiché pour le signaler

je bute surtout sur la boucle

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
 
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 r As Range
Dim r1 As String
 
Set r = f2.Range("D14:D19")
 
Dim i As Integer
Dim j As Integer
Dim nbligne As Long
 
nbligne = f1.Range("A1").CurrentRegion.Rows.Count
 
i = 2
j = 14
 
Do Until i = nbligne
'For i = 2 To nbligne Step 1
pb = f1.Cells(i, 1).Value
 
'For j = 14 To 19 Step 1
'With r1
'for jFor Each r1 In r
 
Do Until j = 19
 
     csa = f2.Cells(j, 4).Value
 
        If csa = pb 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
 
        Else
 
                     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
 
     j = j + 1
 
     Loop
 
i = i + 1
Loop
 
End Sub

je suis a bout mais je persevere.
mon code n'est pas complet je montre juste la boucle ici...

**SfJ5Rpw8** · 25/06/2006, 23h17

va falloir que tu te calme et arrêter de changer de méthode de boucle à chacun de tes posts

garde un code et ne change pas tout... pour rajouter de nouvelles erreurs..

bon la dans tes boucles do until ... déjà à premiére vue tu n'initialise pas la variable j (ligne j=14) au bon endroit .. donc tu ne dois parcourir la boucle j qu'une fois ..!

**VBBBA** · 25/06/2006, 23h19

ca aussi ca marche pas!!!

**VBBBA** · 25/06/2006, 23h20

excact!

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

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager