Re : Crétaion d'une Macro pour automatiser
Bonjour grodep,
J'ai joint 3 fichiers :
Fichier 1 et Fichier 2 sont les fichiers que je vais récupérer
Le fichier Total est le fichier que je souhaite avoir au final.. en fait j'ai déjà commençé à utiliser une macro trouvé sur le forum mais elle ne me convenait qu'à moitié donc j'ai bidouillé un peu mais c'est pas encore mon attente final.
En fait ce sont des fichiers qui me seront envoyé tous les mois et je devrais faire un croisé dynamique par mois de mon fichier Total pour les colonnes ou j'ai des chiffres afinq que j'ai par mois les infos qui me seront envoyé...
dis moi si ce n'est pas clair
Steph
PS: Ci-dessous le code de la macro que j'ai commençé à utiliser
Sub ImportXLSFile()
'code de Coriolan modif par MJ issu de
https://www.excel-downloads.com/threads/pb-dimportation-dobjets-dans-une-macro.83569/
'Dim ceclasseur As String
'Dim monrépertoire As String
'Dim ii As Integer
'monrépertoire = "nom du répertoire contenant les fichiers .txt à importer"
'Stop
choisirRepertoire
ceclasseur = ThisWorkbook.Name
Set fc = CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Files
If fc.Count > 0 Then 'il y a des fichiers
ii = 0
For Each f1 In fc
If Right(f1.Name, 3) = "xls" Or Right(f1.Name, 3) = "XLS" Then 'c'est un fichier texte
'ii = ii + 1
nomxls = f1.Name
ii = ActiveSheet.Range("C65536").End(xlUp).Row
'Workbooks.OpenText Filename:= _
chemin & "\" & f1.Name, Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Semicolon:=True
'Workbooks.Open Filename:=f1.Name
Workbooks.Open Filename:=chemin & "\" & nomxls
'inclu_nom_fichier début
derligne = ActiveSheet.Range("C65536").End(xlUp).Row
Range("A1:A" & derligne).Select
Selection.Insert Shift:=xlToRight
Selection.FormulaR1C1 = f1.Name
'inclu_nom_fichier fin
derligne = ActiveSheet.Range("C65536").End(xlUp).Row
'Rows(1).Copy Workbooks(ceclasseur).Sheets(1).Range("A" & ii + 1)
Rows(2 & ":" & derligne).Copy Workbooks(ceclasseur).ActiveSheet.Range("A" & ii + 1) 'Attention "Rows (2 " permet de ne pas copier le titre des fichier
ActiveWorkbook.Close savechanges:=False
End If
Next
End If
'Columns("A:IV").Select
'Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
Sub choisirRepertoire()
' dl
'Racine = Range(R).Value
activedir = "C:\"
'Stop
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire pour" & choix, &H1&, activedir)
On Error Resume Next
'MsgBox objFolder.Title
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path
If objFolder.Title = "" Then chemin = ""
x = InStr(objFolder.Title, ":")
If x > 0 Then chemin = Mid(objFolder.Title, x - 1, 2) & ""
If Not Len(chemin) = 0 Then Range(R) = chemin
End Sub