Menu

Modifier Macro ajouter une colonne [Résolu]

Messages postés
522
Date d'inscription
lundi 29 décembre 2014
Dernière intervention
18 mars 2019
- - Dernière réponse : nonossov
Messages postés
522
Date d'inscription
lundi 29 décembre 2014
Dernière intervention
18 mars 2019
- 18 mars 2019 à 11:39
Bonjour,

J'ai cette macro qui se base à ouvrer un fichier et faire un copier coller :

Sub OpenFiles()
Application.ScreenUpdating = False
Dim w As Workbook
Dim w1 As Workbook

ThisWorkbook.Sheets("Feuil1").Range("A1:Z65000").ClearContents

'Open les variable file
Set w = Workbooks.Open(ThisWorkbook.Sheets("Interface").Range("E4"))
w.Worksheets(1).Activate
w.ActiveSheet.Cells.Copy Destination:=ThisWorkbook.Sheets("Les variables").Range("A1")
w.Close savechanges:=False

'open data file
Set w1 = Workbooks.Open(ThisWorkbook.Sheets("Interface").Range("E6"))
lr = w1.ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row
w1.ActiveSheet.Range("C1", w1.ActiveSheet.Range("C" & lr)).Copy Destination:=ThisWorkbook.Sheets("Feuil1").Range("A1")
ThisWorkbook.Activate
ThisWorkbook.Sheets("Feuil1").Activate
'call macro
Call decoupe
ThisWorkbook.Sheets("Feuil1").Columns("A:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
w1.ActiveSheet.Range("A1", w1.ActiveSheet.Range("B" & lr)).Copy Destination:=ThisWorkbook.Sheets("Feuil1").Range("A1")
w1.ActiveSheet.Range("E1", w1.ActiveSheet.Range("H" & lr)).Copy Destination:=ThisWorkbook.Sheets("Feuil1").Range("F1")
w1.Close savechanges:=False
ThisWorkbook.Sheets("Feuil1").Columns("D:D").Delete Shift:=xlToLeft
ThisWorkbook.Sheets("Feuil1").Columns.AutoFit
MsgBox "Task Completed...."
Application.ScreenUpdating = True
End Sub
Sub GetFilePath1()

Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With

ActiveSheet.Range("E4") = FileSelected
End Sub
Sub GetFilePath2()

Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With

ActiveSheet.Range("E6") = FileSelected
End Sub


Si vous pouvez m'aider à modifier cette macro pour qu'elle peut ajouter une colonne vide au fichier source avant de faire copier coller, la colonne vide ajoutée doit etre entre colonne C et D.


Merci infiniment



Configuration: Windows / Firefox 52.0
Afficher la suite 

Votre réponse

3 réponses

Messages postés
522
Date d'inscription
lundi 29 décembre 2014
Dernière intervention
18 mars 2019
0
Merci
Voila le fichier :

https://www.cjoint.com/c/ICgkCzB8nA0
Commenter la réponse de nonossov
Messages postés
14120
Date d'inscription
dimanche 25 novembre 2007
Dernière intervention
23 mars 2019
1318
0
Merci
Re,

Tout a fait Thierry, mais de quel fichier source, le premier ou le deuxieme????????????????????????
nonossov
Messages postés
522
Date d'inscription
lundi 29 décembre 2014
Dernière intervention
18 mars 2019
-
je vais vous envoyer les deux pour voir de pres
1/ https://www.cjoint.com/c/ICgqTE0MBU0
2/ https://www.cjoint.com/c/ICgqUlM4Qq0

MERCI
f894009
Messages postés
14120
Date d'inscription
dimanche 25 novembre 2007
Dernière intervention
23 mars 2019
1318 -
Re,

Merci, mais dans quel fichier il faut inserer une colonne???????
nonossov
Messages postés
522
Date d'inscription
lundi 29 décembre 2014
Dernière intervention
18 mars 2019
-
Merci pour votre reponse:

Dans le premier fichier: https://www.cjoint.com/c/ICgqTE0MBU0

Merci infiniment
f894009
Messages postés
14120
Date d'inscription
dimanche 25 novembre 2007
Dernière intervention
23 mars 2019
1318 -
Bonjour,

Ok
Commenter la réponse de f894009
Messages postés
14120
Date d'inscription
dimanche 25 novembre 2007
Dernière intervention
23 mars 2019
1318
0
Merci
Bonjour,

Fichier modifie, mais comprends pas le but du jeu!!!!

https://mon-partage.fr/f/9N2iUvSE/
nonossov
Messages postés
522
Date d'inscription
lundi 29 décembre 2014
Dernière intervention
18 mars 2019
-
Bonjour,

Merci infiniment. :)
Commenter la réponse de f894009