Copier/Coller données fichiers source et destination avec noms inconnus
Bonjour,
cela fait 3j que je navigue sur le net sans trouver des posts qui fixeront mon problème.
J'ai créé un macro qui:
1) Ouvre un fichier excel (Pas le meme nom)
2)Le formate avec les caractéristiques nécessaire
3)Ouvre un second fichier (qui peut changer de nom)
4) Copy toutes les données de la feuille du second fichier
Mon besoin:
Arriver a coller les données sélectionnées dans le premier fichier.
Puis de faire un vlookup.
La difficulté que j'ai est de:
a) Retourner dans le fichier 1
b)ajouter un onglet
c) coller les données du fichier 2 dans ce nouvel onglet
d)Activer le premier onglet du fichier 1 pour faire la recherche V
Pouvez vous m'aider s'il vous plait? Le code doit etre le plus générique possible car les deux fichiers (source et destination) changent de nom.
Un grand merci et prenez soin de vous.
Voici la partie du code
Private Sub Workbook_Open()
'Sub import_KDE_file()
'
' import_KDE Macro
' Macro enregistrée le 03/06/20
Dim my_FileName As Variant
'modification du chemin par defaut'
ChDir ("c:\")
'affichage de la boite de dialogue Ouvrir
my_FileName = Application.GetOpenFilename(filefilter:="classeur Microsoft Excel(*.xls),*.xls,All Files (*.*),*.*,PageWeb(*.htm;*.html),*.htm;*.html", FilterIndex:=2, Title:="Select KDE to format", MultiSelect:=False)
If my_FileName = False Then
MsgBox ("No file selected.Please try again")
my_FileName = Application.GetOpenFilename(filefilter:="classeur Microsoft Excel(*.xls),*.xls,All Files (*.*),*.*,PageWeb(*.htm;*.html),*.htm;*.html", FilterIndex:=2, Title:="Select KDE to format", MultiSelect:=False)
End If
If my_FileName = False Then
MsgBox ("NO FILE SELECTED. GOOD BYE")
End If
If my_FileName <> False Then
Set KDE = Application.Workbooks.Open(my_FileName)
End If
'Insert Columns and name them
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D1").Select
ActiveCell.FormulaR1C1 = "Prioritized"
Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "Ages"
Columns("P:P").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("P1").Select
ActiveCell.FormulaR1C1 = "€ amount"
'Change Date format (DIC, DEC, TRESO)
Columns("K:K").Select
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 5), TrailingMinusNumbers:=True
Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 5), TrailingMinusNumbers:=True
Columns("M:M").Select
Selection.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 5), TrailingMinusNumbers:=True
'Define breaks ages
Range("N2").Select
Range("N2").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = _
"=IF((MAX(C[-3])-RC[-3]<31),""0-1"", IF(AND((MAX(C[-3])-RC[-3]>29),((MAX(C[-3])-RC[-3]<61))),""1-3"",IF(AND((MAX(C[-3])-RC[-3]>40),((MAX(C[-3])-RC[-3]<121))),""3-6"",IF(AND((MAX(C[-3])-RC[-3]>100),((MAX(C[-3])-RC[-3]<181))),""6-9"",IF(AND((MAX(C[-3])-RC[-3]>160),((MAX(C[-3])-RC[-3]<241))),""9-12"",IF((MAX(C[-3])-RC[-3])>240,"">12"",""WHAT???""))))))"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N" & Range("K" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
'Name rate column
Range("AD1").Select
ActiveCell.FormulaR1C1 = "RATE"
'Open Rate file
Dim Rate As Variant
Application.ScreenUpdating = False
ChDrive "C:" ' Choix du lecteur
ChDir "C:\" 'Choix du répertoire
Rate = Application.GetOpenFilename(filefilter:="classeur Microsoft Excel(*.xls),*.xls,All Files (*.*),*.*,PageWeb(*.htm;*.html),*.htm;*.html", FilterIndex:=2, Title:="Select the Rate workbook", MultiSelect:=False)
Set TX = Application.Workbooks.Open(Rate)
TX.Activate 'Activation Fichier Source
Selection.Copy
'La ou je bloque
KDE.Activate 'Retour au fichier de destination
Sheets.Add After:=ActiveSheet 'ajout d'une feuille
Range("A1").Select 'selection cellule A1
Selection.Paste 'Coller
ActiveSheet.Previous.Select 'Retourner à la premiere feuille pour faire ma recherche V
Range("AD2").Select 'Destination de ma recherche V
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-25],Sheet1!C[-28]:C[-27],2,0)"
Range("AD2").Select
Selection.AutoFill Destination:=Range("AD2:AD" & Range("E" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
End Sub