Problème Copier Coller Colonne VBA

Version imprimable

Bonjour,

N'étant pas très doué en VBA, je n'arrive pas à copier/coller correctement deux colonnes (Colonne 1 feuil 1 et Colonne 2 feuil 2) dans la feuil 3.
Je m'explique :

Ma feuil 1 --> User

Colonne 1
TOTO
TATA
TITI

Ma feuil 2 --> Dep

Colonne 1 
PARIS
LILLE 
LYON

Ma feuil 3 --> DepToUser

Colonne 1   Colonne 2 
TOTO         PARIS
TOTO         LILLE
TOTO         LYON
TATA         PARIS
TATA         LILLE
TATA         LYON
...             ...

Voici mon code :

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
Sub Macro1()
 Dim Wb As Workbook
    Dim Ws1 As Worksheet: Worksheets("Dep").Activate
    Dim Ws2 As Worksheet: Worksheets("User").Activate
    Dim Ws3 As Worksheet: Worksheets("DepToUser").Activate
    Dim var1 As String
    Dim var2 As String
    Dim i As Integer
    Dim y As Integer
 
            'Parcours les Users       
            For i = 2 To 3
                'Parcours les Dep
                For y = 2 To 23
                    var1 = Sheets("User").Cells(i, 1)
                    'MsgBox (var1)
                    var2 = Sheets("Dep").Cells(y, 1)
                    'MsgBox (var2)
 
                    'MsgBox ("Je copie " & var1 & " ET " & var2)
                    Sheets("DepToUser").Cells(y, 1).Value = var1
                    Sheets("DepToUser").Cells(y, 2).Value = var2
                Next y
            Next i
End Sub

Merci !

TA

C'est juste un problème de logique …

Comme le code n'est pas balisé (voir donc les règles de ce forum, il y a même une animation pour les moins doués !)
je me suis arrêté aux Activate inutiles !

A partir de l'explication précédant le code, voici un premier exemple, version débutant :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Demo1()
        Dim Rg As Range, N&, R&
        Application.ScreenUpdating = False
        Feuil3.UsedRange.Clear
        N = Feuil2.UsedRange.Rows.Count
        R = 1 - N
    For Each Rg In Feuil1.UsedRange.Columns(1).Cells
        R = R + N
        Rg.Copy Feuil3.Cells(R, 1).Resize(N)
    Next
        Feuil2.UsedRange.Columns(1).Copy Feuil3.UsedRange.Columns(1).Offset(, 1)
        Application.Goto Feuil3.Cells(1), True
        Application.ScreenUpdating = True
End Sub

Une variante de la logique de la copie de Feuil2 :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Demo1v()
        Dim Rg As Range, N&, R&
        Application.ScreenUpdating = False
        Feuil3.UsedRange.Clear
        N = Feuil2.UsedRange.Rows.Count
        R = 1
    For Each Rg In Feuil1.UsedRange.Columns(1).Cells
        Rg.Copy Feuil3.Cells(R, 1).Resize(N)
        R = R + N
    Next
        Feuil2.UsedRange.Columns(1).Copy Feuil3.Cells(2).Resize(R - 1)
        Application.Goto Feuil3.Cells(1), True
        Application.ScreenUpdating = True
End Sub

______________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé …

27/04/2016, 17h24
Thomas A

Merci beaucoup Marc L ca fonctionne bien !
Par contre je n'est pas tout compris dans ton code :/
27/04/2016, 17h28
Marc-L

C'est le B-A-BA du modèle objet d'Excel en VBA, heureusement que je n'ai pas proposé de solution avancée !

Pour toute aide sur une instruction du code, placer le curseur texte dessus puis appuyer sur la touche:f1: !
Tout y est …

______________________________________________________________________________________________________
Il n'y a pas que les aigles qui atteignent les sommets, les escargots aussi mais ils en bavent !
27/04/2016, 17h56
Thomas A

Yes ! Merci beaucoup !