XL 2019 vba copier colonnes non adjacentes

[Debor@h]

Bonjour a tous,
Besoin d'un grand aide, je débute en macro vba et je souhaite la chose suivante :

j'ai fichier (dans lequel j'ai copié la macro ci dessous), quand je clique sur mon bouton une fenêtre s'ouvre pour allé chercher un fichier.
c'est dans ce fichier (que l'on vient d'ouvrir) que je souhaite copier les colonnes C H J N (mais a partir de la ligne 7) et que je souhaite coller (dans le fichier ou se trouve la macro) en colonne G M N I


Fichier source colonne C va devoir se copier en colonne G dans le fichier de destination
C --> G
G --> M
H --> N
J --> I

Quelqu'un peut il m'aider
je vous remercie par avance, je suis dans une grand galére


Sub RecuperationDataFichier()

'Déclaration des variables
Dim ListeFichier As Variant
Dim MonClasseur As Workbook
Dim Colonne_a_supprimer As Long

'On désactive le presse-papier et le rafraichissement de l'écran
Application.CutCopyMode = False
Application.ScreenUpdating = False


'On efface les anciennes données
ActiveSheet.Range("A5").CurrentRegion.Clear
'On récupére le fichier des données à copier
ListeFichier = Application.GetOpenFilename(Title:="Selectionnez votre classeur", _
filefilter:="Fichiers Excel(*.xls*),*xls", ButtonText:="Cliquez")
'Prévoir le cas du bouton Annuler
If ListeFichier <> False Then
'On affecte le fichier sélectionné
Set MonClasseur = Application.Workbooks.Open(ListeFichier)
'On copie les données de la feuille du classeur sélectionné
MonClasseur.Sheets(2).Range("A5").CurrentRegion.Copy
'On colle les donnée dans la feuille active
ThisWorkbook.ActiveSheet.Range("A5").PasteSpecial xlPasteValues
'On desactive les messages d'alerte de Microsoft
Application.DisplayAlerts = False
'On ferme la classeur sources
MonClasseur.Close

End If

'On ré-active le presse-papier et le rafraichissement de l'écran
Application.CutCopyMode = True
Application.ScreenUpdating = True

'Mise en forme des extractions
'On va ajuster les colonnes des tableaux
Range("A5").Select
Cells.EntireColumn.AutoFit


End Sub

 

[Debor@h]

re,
non c'est bon j'ai réussit
merci infiniment

 

[Debor@h]

re re,
Le fait que se soit sur le même classeur ça ne me dérange pas
je vais crée un autre bouton macro qui enregistrera la feuille dans un fichier .csv

par contre la macro fonctionne quand il n'y a que deux onglets (Feuil1 et Feuil 2)
je n'arrive pas a l'appliquer dans mon cas ou j'ai 6 onglets

 

[Debor@h]

Par contre la première macro que vous avez mit dans le post 12 fonctionne avec plein d'onglet
mais ne dispatch pas dans les bonnes colonnes et ne copie pas les données a partir de la ligne 2 (car je doit garder mes entêtes de colonnes)
j'ai trop mal au crane ce soir, un pti Efferalgan sera le bienvenus

 

[Debor@h]

Voici de nouveau le fichier avec des commentaires

 

[Staple1600]

Bonjour le fil, Deborah


Pour faire le test, il suffit de de reproduire strictement ce que je décris dans le message#14
=> Pour te faciliter le test, utilises les codes suivants
Dans un classeur VIERGE avec deux feuilles vides
1) Lances la macro nommée : CREER_DONNEES
Tu obtiens deux tableaux: Tableau1 et Tableau2
2) Lances ensuite la macro d'hier : Recopie_COLONNES_TableauA_vers_TableauB
Tu verrais alors que mon code fonctionne
Et que les colonnes C, G, H et J (du Tableau1) sont copiées respectivement vers les colonnes G, M, N et I (du Tableau2)

Spoiler: Cliquer pour déplier vers le code VBA

Sub CREER_DONNEES()
PREAMBULE Feuil1, Feuil2
End Sub
Sub Recopie_COLONNES_TableauA_vers_TableauB()
Dim cols
cols = Array(Array(3, 7), Array(7, 13), Array(8, 14), Array(10, 9))
Dim tbA As ListObject, tbB As ListObject
Set tbA = Feuil1.ListObjects("Tableau1")
Set tbB = Feuil2.ListObjects("Tableau2")
For i = LBound(cols) To UBound(cols)
tbA.ListColumns(cols(i)(0)).DataBodyRange.Copy tbB.DataBodyRange(1, cols(i)(1))
Next
End Sub
Private Sub PREAMBULE(f1 As Worksheet, f2 As Worksheet)
f1.Range("A1:N1").Formula = "=""COL_""&CHAR(64+COLUMN())": f2.Range("A1:N1").Formula = "=""COL_""&CHAR(64+COLUMN())"
f1.Range("A2:N16").Formula = "=COLUMN()&""_""&ROW()&""_Source"""
f2.Range("A2:N16").Formula = "=REPT(CHAR(RANDBETWEEN(65,90)),RANDBETWEEN(2,3))&""_""&ROW()"
f1.UsedRange = Feuil1.UsedRange.Value: f2.UsedRange = f2.UsedRange.Value
f1.ListObjects.Add(xlSrcRange, f1.Range("$A$1:$N$16"), , xlYes).Name = "Tableau1"
f2.ListObjects.Add(xlSrcRange, f2.Range("$A$1:$N$16"), , xlYes).Name = "Tableau2"
End Sub

 

[Debor@h]

Bonjour,
oui oui j'ai bien compris tous ça la version test fonctionne aussi chez moi
mais ne s'applique pas dans mon cas pratique ou il y a plus de deux onglets
ou alors je fais une mauvaise manipulation

 

[Staple1600]

Bonjour le fil, Debor@ah

Si j'ai distingué plusieurs fois le mot test (en le mettant en gras), c'est bien pour indiquer que mes codes ne sont que des tests.
Tests qu'ils t'appartient en suite d'adapter, modifier pour coller à ton fichier réel. (*)

Déjà , il te suffit de remplacer les noms des tableau par les vrais noms présents dans ton fichier

Pour le reste, je n'ai que suivre ce que décrit ton premier message

c'est dans ce fichier (que l'on vient d'ouvrir) que je souhaite copier les colonnes C H J N (mais a partir de la ligne 7) et que je souhaite coller (dans le fichier ou se trouve la macro) en colonne G M N I

'On copie les données de la feuille du classeur sélectionné
MonClasseur.Sheets(2).Range("A5").CurrentRegion.Copy
'On colle les donnée dans la feuille active

Ces commentaires dans ton code laissent donc entendre que tu ne souhaites traiter que la Feuille 2
(à recopier dans une seconde feuille)

J'ai donc créé mes tests en me basant sur ce postulat
Et c'est pour que tu indiques dans le message#17

par contre la macro fonctionne quand il n'y a que deux onglets (Feuil1 et Feuil 2)

Il n'a jamais été question de ceci dans ton premier message

je n'arrive pas a l'appliquer dans mon cas ou j'ai 6 onglets

(*) Si tu as des difficultés, lors de tes différents essais, reviens dans le fil préciser quels sont tes points de blocages.

EDITION: J'ai ouvert ton fichier du message#19
La modification était à a portée pour que la recopie se fasse en ligne 2, non ?
'recopie des colonnes renseignées dans colonnes: la zone de recopie commence en A2 F_Recopie.Range("A2").Resize(UBound(dbSource) - 6, UBound(dbSource, 2)).Value = dbSource