Macro Excel importation plusieurs fichiers

Bonjour,

j'utilise une macro pour importer plusieurs fichiers excel dans un nouveau fichier. Ce fichier étant maintenant créé je souhaite adapter ma macro pour qu'elle importe les nouveaux fichiers qui seront ajoutés au dossier source dans ce même fichier et non pas en créer un autre.

Je souhaiterais que les nouveaux fichiers importés soient coller à la suite et je ne sais pas comment faire

Voici le code de la macro que j'utilise:

Sub MergeSelectedWorkbooks()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range

    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    ' Modify this folder path to point to the files you want to use.
    FolderPath = "P:\DEP\PPM\POLITIQUE ACHAT\Transfert Infra"

    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    ChDir FolderPath

    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Microsoft Excel Worksheet(*.xlsx*), *.xlsx*", MultiSelect:=True)

    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1

    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)

        ' Open the current workbook.
        Set WorkBk = Workbooks.Open(FileName)

        ' Set the cell in column A to be the site name.
        SummarySheet.Range("A" & NRow).Value = WorkBk.Worksheets(1).Range("B4")
        SummarySheet.Range("B" & NRow).Value = WorkBk.Worksheets(1).Range("B5")
        SummarySheet.Range("C" & NRow).Value = WorkBk.Worksheets(1).Range("B6")
        ' Set the source range to be A9 through C9.
        ' Modify this range for your workbooks. It can span multiple rows.
        Set SourceRange = WorkBk.Worksheets(1).Range("B14:D100")

        ' Set the destination range to start at column B and be the same size as the source range.
        Set DestRange = SummarySheet.Range("D" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
            SourceRange.Columns.Count)

        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value

        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count

        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
    Next NFile

    ' Call AutoFit on the destination sheet so that all data is readable.
    SummarySheet.Columns.AutoFit
End Sub

Je vous remercie par avance pour votre aide.

Salut DankCanada,

essaie ceci (sans avoir pu tester moi-même, bien sûr...)

Sub MergeSelectedWorkbooks()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range

    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    ' Modify this folder path to point to the files you want to use.
    FolderPath = "P:\DEP\PPM\POLITIQUE ACHAT\Transfert Infra"

    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    ChDir FolderPath

    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Microsoft Excel Worksheet(*.xlsx*), *.xlsx*", MultiSelect:=True)

    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)
        ' Open the current workbook.
        Set WorkBk = Workbooks.Open(FileName)
        NRow = SummarySheet.Range("B" & Rows.Count).End(xlUp).Row + 1
        ' Set the cell in column A to be the site name.
        SummarySheet.Range("A" & NRow & "C" & NRow).Value = WorkBk.Worksheets(1).Range("B4:B6").Value
        ' Set the source range to be A9 through C9.
        ' Modify this range for your workbooks. It can span multiple rows.
        Set SourceRange = WorkBk.Worksheets(1).Range("B14:D100")

        ' Set the destination range to start at column B and be the same size as the source range.
        Set DestRange = SummarySheet.Range("D" & NRow + 1)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
            SourceRange.Columns.Count)

        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value

        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
    Next NFile

    ' Call AutoFit on the destination sheet so that all data is readable.
    SummarySheet.Columns.AutoFit
End Sub

A+

Bonjour,

Merci de ta réponse cependant ton code va quand meme me créer une nouvelle feuille/classeur vu que la ligne :

Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1). a été conservé. Mon fichier et mon code a été modifié donc plus la peine de se creuser les meninges sur ça. Cependant si je peux me permettre j'ai une autre question toujours en rapport avec le problème : en fait je souhaite comprendre comment coller les données a la suite de mon fichier. Voici mon code quelque peut modifié (plus ou moins le meme mis a part les selections)

Sub ImportationForecast()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range

    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = ThisWorkbook.Worksheets(1)

    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\JRZD9616\Desktop"

    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    ChDir FolderPath

    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Microsoft Excel Worksheet(*.xlsm*), *.xlsm*", MultiSelect:=True)

   ' NRow keeps track of where to insert new rows in the destination workbook.

        NRow = 1

    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)

        ' Open the current workbook.
        Set WorkBk = Workbooks.Open(FileName)

        ' Set the source range to be C through F.
        ' Modify this range for your workbooks. It can span multiple rows.
        Set SourceRange = WorkBk.Worksheets(3).Range("C:F")

        ' Set the destination range to start at column A and be the same size as the source range.
        Set DestRange = SummarySheet.Range("A" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
            SourceRange.Columns.Count)

        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value

        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count

        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
    Next NFile

    ' Call AutoFit on the destination sheet so that all data is readable.
    SummarySheet.Columns.AutoFit
End Sub

Quand je le compile pas de problème il me colle bien les plages séléctioné dans les feuilles/classeurs mais le problème c'est qu'il me les colles par dessus ce qui est deja present dans mon fichier (global) et non pas a la suite. Je me doute que c'est à cause du NRow = 1

mais quand je l'initialise a la dernière ligne de ma feuille avec

NRow = SummarySheet.Range("A" & Rows.Count).End(xlUp).Row 

jai un message d'erreur sur la ligne

  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
            SourceRange.Columns.Count) 

du coup je sais pas quoi faire.

Merci de votre attention

Salut DankCanada,

• pour mettre à la suite, il faut faire +1

NRow = SummarySheet.Range("A" & Rows.Count).End(xlUp).Row + 1

• à mon sens..., simplifie...
  Au lieu de...

Set SourceRange = WorkBk.Worksheets(3).Range("C:F")
' Set the destination range to start at column A and be the same size as the source range.
Set DestRange = SummarySheet.Range("A" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count

... je ferais plutôt...

iRow = WorkBk.Worksheets(3).Range("C" & Rows.Count).End(xlUp).Row
NRow = SummarySheet.Range("A" & Rows.Count).End(xlUp).Row + 1
SummarySheet.Range("A" & NRow).Resize(iRow, 2).Value = WorkBk.Worksheets(3).Range("C1:F" & iRow).Value

A tester...

A+

Merci de t'as réponse j'ai en effet testé et ça colle bien à la suite cependant je ne comprend pas pourquoi je n'ai que les 2 colonnes (C,D) sur les 4 sélectionnées dans le classeur/feuille source.

Mis à part ce détail, j'ai une autre requête. J'aimerais mettre une condition sur l'importation, j'ai dans ma colonne A du summarysheet des "codes sites" (pas nécessaire de comprendre a quoi je fais allusion c'est juste une référence sous forme de code pour les opérations effectuées) et dans la colonne C de mon/mes fichier(s) source(s) j'ai aussi des codes sites. je voudrai en fait qu'avant importation si un des codes sites du fichier source existe dans le fichier summarysheet la ligne correspondante soit supprimé du fichier summarysheet et la ligne correspondant dans le fichier source soit importé dans le fichier summarysheet. En gros on importe de la même manière qu'auparvant mais on supprime la ligne du code site car elle est rendu obsolete par le nouveau fichier. En fait pour t'expliquer un peu dans la ligne du code site il y a un materiel correspondant au code site et parfois le materiel est modifié dans le nouveau fichier et donc quand on fait l'importation il faut que le materiel correspondant aux sites change aussi c'est pourquoi je cherche a supprimer la ligne

Edit: Par rapport au fait que la macro importe que mes 2 colonnes c'est à cause de l'argumet du .Resize() il fallait juste mettre 4 au lieu de 2 j'avais pas remarqué tout de suite ^^

Salut DankCanada,

désolé pour le resize (,2)! M'en étant rendu compte un peu plus tard, je n'ai pas eu l'occasion d'apporter la correction!

Pour le reste,...

iRow = WorkBk.Worksheets(3).Range("C" & Rows.Count).End(xlUp).Row
'
With Worksheets("SummarySheet")
    NRow = .Range("A" & Rows.Count).End(xlUp).Row
    For x = NRow To 2 Step -1
        For y = 2 To iRow
            If .Range("A" & x).Value = WorkBk.Worksheets(3).Range("C" & y).Value Then
                .Rows(x).Delete shift:=xlUp
                Exit For
            End If
        Next
    Next
    NRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & NRow).Resize(iRow, 4).Value = WorkBk.Worksheets(3).Range("C1:F" & iRow).Value
End With

Meilleurs voeux au Canada!

A+

Merci pour tes réponses si rapide . Je vais tester ça et je mettrais le sujet en résolu. je te remercie encore pour ton aide (de qualité) et je te souhaite de bonne fête de fin d'année.

Ps: Je suis pas du Canada désolé de te décevoir c'est juste le pseudo que j'utilise sur les forum et steam j'ai trouvé ça un soir en voyant une bouteille de CanadaDry .

Re,

Sub ImportationForecast()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim iRow As Long

    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = ThisWorkbook.Worksheets(1)

    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\JRZD9616\Desktop"

    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    ChDir FolderPath

    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Microsoft Excel Worksheet(*.xlsm*), *.xlsm*", MultiSelect:=True)

    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)

        ' Open the current workbook.
        Set WorkBk = Workbooks.Open(FileName)

        iRow = WorkBk.Worksheets(3).Range("C" & Rows.Count).End(xlUp).Row

With Worksheets("SummarySheet")
    NRow = .Range("A" & Rows.Count).End(xlUp).Row
    For x = NRow To 2 Step -1
        For y = 2 To iRow
            If .Range("A" & x).Value = WorkBk.Worksheets(3).Range("C" & y).Value Then
                .Rows(x).Delete shift:=xlUp
                Exit For
            End If
        Next
    Next
    NRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & NRow).Resize(iRow, 4).Value = WorkBk.Worksheets(3).Range("C1:F" & iRow).Value
End With

        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
    Next NFile

    ' Call AutoFit on the destination sheet so that all data is readable.
    SummarySheet.Columns.AutoFit
End Sub

Lorsque je compile ça me donne : Erreur d’exécution '9' L'indice n'appartient pas a la sélection pour la ligne

With Worksheets("SummarySheet") je comprend pas trop d'où vient l'erreur. Est ce que t'as une idée du problème ?

Salut DankCanada,

je n'avais pas bien lu le début du code...

Mets ceci...

With SummarySheet

A+

Merci beaucoup tout fonctionne correctement.

Je te souhaite une très bonne année.