[Résolu] Copier le contenu d'une palge de x cl fermés dans un cl ouvert via macro

[kingfadhel]

Salut les XLDs
J'ai des classeurs qui me parviennent par mail le dernier jour de chaque mois (février 28 classeurs,mars 31, Avril 30 ....)

Rq les noms des classeurs sont du type : "parc JJ-MM-AAAA.xlsx" et sont dans le même dossier que le rapport mensuel.
mot de passe des classeurs: 123

quant à moi je fais le recap du mois dans un seul tableau

donc le problème qui se pose est le suivant:
j'ouvre chaque classeur et je recopie le contenu de la feuille impression et je colles sur mon rapport mensuel

donc je veux une macro qui ouvre chaque classeur du dossier et copie une palge variable (nbr de colonnes fix et nbr de lignes variable) et la colle sur la feuille BD du classeur Mensuel aprés le dernier enregistrement.

je crois que j'ai expliquer tous

Merci d'avance.

 

[Denis]

Re : Copier le contenu d'une palge de x cl fermés dans un cl ouvert via macro

Bonjour kingfadhel et le forum,
Voici un lien vers un excelent tuto.

Lire et crire dans les classeurs Excel ferms
Bon courage et à+
Denis

 

[kingfadhel]

Re : Copier le contenu d'une palge de x cl fermés dans un cl ouvert via macro

Bonjour kingfadhel et le forum,
Voici un lien vers un excelent tuto.

Lire et crire dans les classeurs Excel ferms
Bon courage et à+
Denis

je l'ai consulté, et je n'arrivais pas à réaliser mon job,
j'ai beaucoup avancé avec d'autre mèthode et une fois fini je patagerai le code pour que tout le monde puisse l'utilisé

 

[kingfadhel]

Résolu : Copier le contenu d'une palge de x cl fermés dans un cl ouvert via macro

Salut les xld
enfin j'ai reussi et voila comme promis je partage le code
bonne programmation

Sub Importa()
Dim fd As FileDialog
Dim PathOfSelectedFolder As String
Dim SelectedFolder
Dim SelectedFolderTemp
Dim MyPath As FileDialog
Dim plage1 As String
Dim plage2, plage3 As String
Dim cl, myrange As Range
Dim fs
Dim ExtraSlash
ExtraSlash = "\"
Dim MyFile
'enregistrer une copie du classeur avant modification
Call sauver
'Ouvrir le repertoir
Set MyPath = Application.FileDialog(msoFileDialogFolderPicker)
With MyPath
'Ouvrir une fenetre flottante
        .AllowMultiSelect = False
        If .Show Then
            'selection de dossier
            'Loop dans le dossier choisi
            For Each SelectedFolder In .SelectedItems
                'Nom du dossier selectionné
                PathOfSelectedFolder = SelectedFolder & ExtraSlash
                Set fs = CreateObject("Scripting.FileSystemObject")
                Set SelectedFolderTemp = fs.GetFolder(PathOfSelectedFolder)
                    'Loop dans les fichiers du dossier
                    For Each MyFile In SelectedFolderTemp.Files
                        'Nom du fichier commmencant par "parc" et ayant un mot de passe "123"
                        If InStr(MyFile, "parc") > 0 Then
                        Workbooks.Open Filename:=MyFile, Password:="123"
                        nm = MyFile.Name
                        'Extraction de la date à partir du nom du classeur
                        nomm = Left(Right(nm, 15), 10)
                        jj = Left(nomm, 2)
                        mm = Right(Left(nomm, 5), 2)
                        aaaa = Right(nomm, 4)
                        dte = jj & "/" & mm & "/" & aaaa
                        nmm = CDate(dte) 
                        Sheets("IMPRESSION").Select
                        Sheets("IMPRESSION").Range("k1").Value = nmm
                        'Selection des colonnes F et H pour afficher la colonne G 
                        Columns("F:H").Select
                        Selection.EntireColumn.Hidden = False
                        Cells.Find(What:="FLOTTE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                            False, SearchFormat:=False).Activate
                        
                        ActiveCell.Offset(1, -3).Select
                        Selection.Name = "dcbl"
                        ActiveCell.Offset(0, 7).Select
                        Selection.Name = "cbl"
                        ActiveCell.FormulaR1C1 = "=R1C11-RC[-6]"
                        Range("dcbl").Select
                        Selection.End(xlDown).Select
                        ActiveCell.Offset(0, 7).Select
                        Selection.Name = "fcbl"
                        Range("cbl", "fcbl").Select
                        Selection.FillDown
                        Selection.Copy
                        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        Application.CutCopyMode = False
                        Range("dcbl", "fcbl").Select
                        Selection.Copy
                        'ActiveWindow.Close
                        'Windows(MyFile.Name).Activate
                        Windows(ThisWorkbook.Name).Activate
                        Sheets("BD").Range("B65536").Select
                        Selection.End(xlUp).Select
                        ActiveCell.Offset(1, 0).Select
                        ActiveSheet.PasteSpecial
                        Sheets("BD").Range("B65536").Select
                        Selection.End(xlUp).Select
                        Selection.Offset(0, -1).Select
                        Set myrange = Range(Selection, Selection.End(xlUp).Offset(1, 0))
                            For Each cl In myrange
                            cl.Activate
                            With ActiveCell
                              .NumberFormat = "dd/mm/yyyy" 'ou autre format Date
                              .Value = nmm
                            End With
                            'ActiveCell.Value = .NumberFormat = "m/d/yyyy"
                            Next
                        Windows(MyFile.Name).Activate
                        ActiveWorkbook.Save
                        ActiveWindow.Close
                        End If
                    Next
            Next
        End If
End With
ActiveWorkbook.Save
End Sub

Sub sauver()
Dim Chemin As String, Fichier As String
Chemin = ThisWorkbook.Path
'Ajoute la date du jour et l'heure dans le nom du fichier
Fichier = Left(ThisWorkbook.Name, (Len(ThisWorkbook.Name) - 4)) & "_" & Format(Date, "ddmmyy") & ".xls"
MsgBox Chemin & "\" & Fichier
ActiveWorkbook.SaveCopyAs Chemin & "\" & Fichier
End Sub