Copie de certaines colonnes d'un tableau au-dessus d'un tableau d'une autre feuille

**juju05** · 21/10/2012, 13h59

Bonjour,

Je souhaite copier les colonnes d'un tableau contenu dans une feuille nommée 'TCD' au-dessus d'un tableau contenu dans la feuille 'DISPO'.

Chaque entête de la colonne du tableau contenu dans 'TCD' doit venir se positionner au-dessus de la colonne correspondante du tableau déjà présent dans la feuille 'DISPO'.

Si la colonne du tableau contenu dans 'TCD' n'est pas présente dans le tableau de la feuille 'DISPO' alors je dois cesser le traitement.

La recopie de la colonne ne se passe pas correctement car je n'utilise pas la bonne méthode Excel.

Voici le code :

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
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
 
Private Sub CommandButton1_Click()
 
Dim nbcoltcd As Integer
 Dim NbLignes As Integer
 Dim fin As Boolean
 Dim ko As Boolean
 Dim trouve As Boolean
 Dim datecharge As String
 
' Indice de la colonne traitée dans le 'TCD'
 Dim i As Integer
 
' Indice de la colonne traitée dans la capacité
 Dim j As Integer
 
' Nombre de colonnes de la disponiblité
 Dim nbcoldispo As Integer
 
' Recherche du nombre de colonnes de TCD
 nbcoltcd = Worksheets("TCD").UsedRange.Columns.Count
 
' Recherche du nombre de lignes de TCD
 
NbLignes = Worksheets("TCD").UsedRange.Rows.Count
 
' Recherche du nombre de colonnes à traiter dans le tableau "Capacité." (partie "disponibilité")
 
nbcoldispo = 2
 Do Until Worksheets("DISPO").Cells(10, nbcoldispo).Value = ""
    nbcoldispo = nbcoldispo + 1
 Loop
 nbcoldispo = nbcoldispo - 1
 
MsgBox "Nombre de colonnes à traiter dans le tableau des capacités :" & nbcoldispo
 
' Suppression du tableau de "charge" contenu dans l'entête de la capacité
 
Worksheets("DISPO").Range("B2").CurrentRegion.ClearContents
 
' Copie de la colonne des machines de TCD vers la feuille 'Capacité'
 Worksheets("TCD").Range("A2:A" & NbLignes).Copy Destination:=Sheets("DISPO").Range("A2")
 
' Boucle pour traiter toutes les dates
 ' Fin-trt, j'ai traité toutes les dates,
 ' Trt-ko, je ne trouve pas ma date dans la colonne des disponibilités
 
ko = False
 fin = False
 
i = 2
 
Do Until fin Or ko
 
    ' Recherche de la date dans la colonne de disponibilité
     trouve = False
 
    ' Initialisation de la colonne traitée dans la disponibilité
     j = 2
 
    datecharge = Worksheets("TCD").Cells(2, i).Value
 
    Do Until trouve Or ko
        ' MsgBox "je passe dans boucle"
         If Worksheets("DISPO").Cells(10, j).Value > datecharge Then
            ko = True
            MsgBox "ko"
         Else
             If datecharge = Worksheets("DISPO").Cells(10, j).Value Then
                MsgBox "Date trouvée : " & datecharge
                trouve = True
             End If
         End If
         j = j + 1
     Loop
 
    ' Si trouvé alors je copie la colonne de la "Charge" vers les dispo.
     If trouve Then
        j = j - 1
        MsgBox "Je copie la colonne n° " & i & " du tableau de tcd vers la colonne " & j & "du tableau de disponibilité."
        Worksheets("TCD").Range(Cells(2, i), Cells(NbLignes, i)).Copy
        MsgBox ("copie")
 
        Worksheets("DISPO").Range(Cells(2, j)).PasteSpecial xlPasteValues
 
**** la recopie plante sur la ligne ci-dessous
        Worksheets("TCD").Range(Cells(2, i), Cells(NbLignes, i)).Copy Destination:=Worksheets("DISPO").Range(Cells(2, j), Cells(NbLignes, j))
        MsgBox "J'ai copié !"
     End If
 
    ' Passage à la colonne suivante du tcd
     If ko = False Then
          i = i + 1
          If i > nbcoltcd Then
             fin = True
          End If
     End If
 
  Loop
 
If ko Then
    MsgBox "Traitement incorrect !"
 End If
 
End Sub

A l'exécution de la ligne de code située sous la ligne *****
j'ai le message d'erreur : "Erreur d'exécution 1004. Erreur définie par l'application ou par l'objet."

Merci d'avance.

**Daniel.C** · 21/10/2012, 16h22

Bonjour,

Essaie ce code. Le tableau source se nomme "TC" et le tableau cible se nomme "Disp" :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
    Dim TCD As Worksheet, Dispo As Worksheet, Col, Plage As Range
    Set TCD = Sheets("TCD")
    Set Dispo = Sheets("Dispo")
    Var = [TC].Column
    For i = 1 To [TC].Columns.Count
        Col = Application.Match(Range("TC")(1, i), [Disp].Rows(1), 0)
        If Not IsNumeric(Col) Then Exit Sub
        Set Plage = [TC].Columns(i).Offset(1).Resize([TC].Columns(i).Rows.Count - 1)
        Range("Disp")(2, Col).Resize(Plage.Rows.Count).Insert xlShiftDown
        Range("Disp")(2, Col).Resize(Plage.Rows.Count).Value = _
            Plage.Value
    Next i
End Sub

**juju05** · 21/10/2012, 16h54

Bonjour,

Le tableau est déjà existant dans la feuille cible. J'ai un problème d'utilisation de méthode lors du paste. Je ne sais pas comment utiliser le range et un numéro et ligne et de colonne qui sont des chiffres.

**Daniel.C** · 21/10/2012, 17h11

J'ai bien compris, mais il y a peut-être un problème de disposition des données.
Regarde le classeur jooint.

**juju05** · 21/10/2012, 17h14

J'effectue mon test sur ce classeur.

**Daniel.C** · 21/10/2012, 18h55

Alors utilise ce 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
    Dim TCD As Worksheet, Dispo As Worksheet, Col, Plage As Range
    Dim C As Range, NbLignes As Integer
    Set TCD = Sheets("TCD")
    Set Dispo = Sheets("DISPO")
    With TCD
        NbLignes = Application.CountA(.[A:A])
        For Each C In .Range(.[B2], .Cells(2, .Columns.Count).End(xlToLeft))
            Col = Application.Match(C.Value, [Dispo].Rows(10), 0)
            If Not IsNumeric(Col) Then
                MsgBox "Traitement anormal"
                Exit Sub
            End If
        Dispo.Cells(3, Col).Resize(NbLignes).Value = C.Offset(1).Resize(NbLignes).Value
        Next C
    End With

**juju05** · 21/10/2012, 19h05

Il ne me manque plus que l'entête des colonnes du tableau source dans le tableau cible. Les données y sont à présent.

Je ne vois pas comment positionner les entêtes de mon tableau source dans la feuille cible.

**Daniel.C** · 21/10/2012, 21h42

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
    Dim TCD As Worksheet, Dispo As Worksheet, Col, Plage As Range
    Dim C As Range, NbLignes As Integer
    Set TCD = Sheets("TCD")
    Set Dispo = Sheets("DISPO")
    With TCD
        NbLignes = Application.CountA(.[A:A])
        For Each C In .Range(.[B2], .Cells(2, .Columns.Count).End(xlToLeft))
            Col = Application.Match(C.Value, [Dispo].Rows(10), 0)
            If Not IsNumeric(Col) Then
                MsgBox "Traitement anormal"
                Exit Sub
            End If
        Dispo.Cells(2, Col).Resize(NbLignes + 1).Value = C.Resize(NbLignes + 1).Value
        Next C
    End With

Je ne vois pas comment positionner les entêtes de mon tableau source dans la feuille cible.

C'est la ligne suivante qui récupère le n° de la colonne en faisant l'équivalent de la fonction EQUIV sur la ligne 10 de la feuille DISPO.

**juju05** · 22/10/2012, 06h34

Merci beaucoup !

Copie de certaines colonnes d'un tableau au-dessus d'un tableau d'une autre feuille [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager