Copier une feuille vers une autres en VBA [Résolu]

[zemblamoh]

Bonjour,
J’ai feuille1 Excel du classeur1 avec des colonnes prédéfinies mais vides et j’ai une feuille2 chargée de données du classeur2 avec des colonnes sous des titres quelconques et je veux copier en VBA la feuille2 sur la feuille1 en ouvrant une boite de dialogue qui me demandera les correspondances entre les colonnes. Est-ce possible ? Si oui comment procéder (Un code VBA serait le bienvenu)?
Merci

[Daniel.C]

Bonjour,

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Essaie la macro suivante. Si une colonne ne doit pas être copiée, clique sur "Annuler" :
 
Sub test()
'Réf. zemblamoh 111121.xlsm
Dim Col As Integer, Cible As String, Source As String
With Sheets("Feuil2")
    Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For i = 1 To Col
        Source = Cells(1, i).Address(0, 0)
        Source = Split(Source, "1")(0)
        Cible = InputBox("Où faut il coller la colonne " & Source & "?")
 
        If Application.IsText(Cible) And Cible <> "" Then
            .Cells(1, Source).EntireColumn.Copy
            Sheets("Feuil1").Cells(1, Cible).PasteSpecial xlPasteValues
        End If
    Next i
End With
End Sub

[zemblamoh]

Je viens d'insérer votre code dans un exemple mais il bloque au niveau de:

Code :

Sheets("Feuil1").Cells(1, Cible).PasteSpecial xlPasteValues

En plus il me dicte les colonnes A, B, C... au lieu des titres de la 1ère ligne de "Feuil2".
j'ai fait l'exemple dans un fichier xlsx.
Message d'erreur:

Erreur d'exécution "1004"
Erreur définie par l'application ou par l'objet.

Merci pour votre aide

[Daniel.C]

En plus il me dicte les colonnes A, B, C... au lieu des titres de la 1ère ligne de "Feuil2".

Tu préfères les titres ? et tu réponds en renseignant les lettres de la colonne correspondante ? Quelle était la colonne affichée, et qu'est-e que tu as saisi ?

[zemblamoh]

Oui, je préfère les titres de la "feuil2".
Oui, je le renseigne avec titre de "feuil1"
Quand je démarre la macro, il affiche:

Où faut il coller la colonne A

et je réponds en renseignant avec le titre voulu de la "feuil1".
Merci pour votre patience

[Daniel.C]

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub test()
'Réf. zemblamoh 111121.xlsm
Dim Col As Integer, Cible As String, Source As String, Teste As Variant
With Sheets("Feuil2")
    Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For i = 1 To Col
        Cible = InputBox("Où faut il coller la colonne " & .Cells(1, i) & "?")
        Teste = Application.Match(Cible, Sheets("Feuil1").Rows(1), 0)
        If IsNumeric(Teste) Then
            Range(.Cells(2, i), .Cells(.Rows.Count, i).End(xlUp)).Copy
            Sheets("Feuil1").Cells(2, Teste).PasteSpecial xlPasteValues
        End If
    Next i
End With
End Sub

[zemblamoh]

Merci beaucoup ça marche à merveille.

[zemblamoh]

Bonjour,
J'aimerai revenir sur ce sujet si c'est possible. Je souhaite dans le dialogue générer par ce programme:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub test()
'Réf. zemblamoh 111121.xlsm
Dim Col As Integer, Cible As String, Source As String, Teste As Variant
With Sheets("Feuil2")
    Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For i = 1 To Col
        Cible = InputBox("Où faut il coller la colonne " & .Cells(1, i) & "?")
        Teste = Application.Match(Cible, Sheets("Feuil1").Rows(1), 0)
        If IsNumeric(Teste) Then
            Range(.Cells(2, i), .Cells(.Rows.Count, i).End(xlUp)).Copy
            Sheets("Feuil1").Cells(2, Teste).PasteSpecial xlPasteValues
        End If
    Next i
End With
End Sub

De vérifier quand je renseigne le titre de la feuille2 si ce titre existe ou pas. Dans ce cas dernier que le programme m'avertisse par un message et que le curseur revient de nouveau pour renseigner le titre en erreur.
Merci pour toute aide

[Daniel.C]

Bonjour,

Essaie comme ceci :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
'Réf. zemblamoh 111121.xlsm
Dim Col As Integer, Cible As String, Source As String, Teste As Variant
With Sheets("Feuil2")
    Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For i = 1 To Col
        Cible = InputBox("Où faut il coller la colonne " & .Cells(1, i) & "?")
        Teste = Application.Match(Cible, Sheets("Feuil1").Rows(1), 0)
        If IsNumeric(Teste) Then
            Range(.Cells(2, i), .Cells(.Rows.Count, i).End(xlUp)).Copy
            Sheets("Feuil1").Cells(2, Teste).PasteSpecial xlPasteValues
        Else
            MsgBox "Titre cible incorrect"
            i = i - 1
        End If
    Next i
End With
End Sub

[zemblamoh]

Merci beaucoup, ça marche bien