Copier coller des données

Bonjour à tous,

J'ai un script VBA qui transfère des données depuis plusieurs fichiers Excel (fichiers ERH, PRT, BRT) vers un fichier cible. Voici ce que fait mon script :

1. Il demande une plage de dates (début et fin) via des InputBox.
2. Il filtre les données dans les fichiers sources selon ces dates.
3. Il copie les données filtrées dans une feuille spécifique du fichier cible.(par exemple, les données du fichier ERH vont dans la feuille"SRS_File"

Ce que je voudrais ajouter :
À la fin du transfert, je voudrais une MessageBox qui demande à l'utilisateur :

• "Souhaitez-vous ajouter d'autres données ?"
  Si l'utilisateur répond "Oui" :
• Le script permet de sélectionner de nouveaux fichiers.
• Les données récupérées doivent être ajoutées à la suite des données déjà présentes (dans les lignes qui suivent, tout en respectant l'ordre chronologique basé sur les dates).

Exemple :

• Je sélectionne un premier fichier avec des données allant du 10/11 au 25/11. Ces données sont copiées dans la feuille cible (lignes 2 à 17).
• Ensuite, je sélectionne un autre fichier avec des données allant du 01/12 au 05/12. Ces données doivent être ajoutées à la suite (à partir de la ligne 18), tout en respectant leur ordre chronologique.

J'ai essayé d'intégrer cette fonctionnalité, mais ça ne fonctionne pas comme prévu.

Merci d'avance pour votre aide !

    feuillesMisesAJour = ""

dateDebut = InputBox("Entrez la date de début (format JJ/MM/AAAA) :", "Date de début")
dateFin = InputBox("Entrez la date de fin (format JJ/MM/AAAA) :", "Date de fin")
If IsDate(dateDebut) And IsDate(dateFin) Then
    dateDebutDate = CDate(dateDebut)
    dateFinDate = CDate(dateFin) + TimeSerial(23, 59, 59)
Else
    MsgBox "Les dates saisies ne sont pas valides. Veuillez réessayer.", vbCritical
    Exit Sub
End If

fichierSources = Application.GetOpenFilename("Tous les fichiers (*.*), *.*", MultiSelect:=True, Title:="Choisir les fichiers ERH, PRT et BRT")
If IsArray(fichierSources) = False Or UBound(fichierSources) < 2 Then
    MsgBox "Vous devez sélectionner au moins 3 fichiers qui commencent par ERH, PRT ou BRT.", vbCritical
    Exit Sub
End If

On Error Resume Next
Set wbCible = Workbooks("Transform_Fichier_Cuve_v5.0 1.xlsm")
On Error GoTo 0
If wbCible Is Nothing Then
    MsgBox "Le fichier cible 'Transform_Fichier_Cuve_v5.0 1.xlsm' n'est pas ouvert.", vbCritical
    Exit Sub
End If

For Each nomFichier In fichierSources
  'converti le fichier .xlsx en .xslm
Set wbSource = Workbooks.Open(nomFichier)
Dim cheminConversion As String
cheminConversion = Left(nomFichier, Len(nomFichier) - 4) & ".xlsm"
wbSource.SaveAs Filename:=cheminConversion, FileFormat:=xlOpenXMLWorkbookMacroEnabled
wbSource.Close SaveChanges:=False
Set wbSource = Workbooks.Open(cheminConversion)

    prefixe = UCase(Trim(Left(wbSource.Name, 4)))
    If prefixe = "ERH" Then
        Set wsCible = wbCible.Sheets("SRS_File")
        feuillesMisesAJour = feuillesMisesAJour & "SRS_File, "
    ElseIf prefixe = "PRT" Then
        Set wsCible = wbCible.Sheets("PRT_File")
        feuillesMisesAJour = feuillesMisesAJour & "PRT_File, "
    ElseIf prefixe = "BRT" Then
        Set wsCible = wbCible.Sheets("BRT_File")
        feuillesMisesAJour = feuillesMisesAJour & "BRT_File, "
    Else
        MsgBox "Le fichier " & wbSource.Name & " ne commence pas par ERH, PRT ou BRT.", vbExclamation
        wbSource.Close SaveChanges:=False
        GoTo NextFile
    End If

    Set wsSource = wbSource.Sheets(1)
    derniereLigneSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    derniereColonneSource = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
    derniereLigneCible = wsCible.Cells(wsCible.Rows.Count, "A").End(xlUp).Row

    If derniereLigneCible > 1 Then
        wsCible.Rows(2 & ":" & derniereLigneCible).ClearContents
    End If

    cibleLigne = 2
    For i = 2 To derniereLigneSource
        If IsDate(wsSource.Cells(i, 1).Value) Then
            sourceDate = CDate(wsSource.Cells(i, 1).Value)
            If sourceDate >= dateDebutDate And sourceDate <= dateFinDate Then
                wsSource.Range(wsSource.Cells(i, 1), wsSource.Cells(i, derniereColonneSource)).Copy Destination:=wsCible.Cells(cibleLigne, 1)
                cibleLigne = cibleLigne + 1
            End If
        End If
    Next i
    wbSource.Close SaveChanges:=False
NextFile:
Next nomFichier

If feuillesMisesAJour <> "" Then
    feuillesMisesAJour = Left(feuillesMisesAJour, Len(feuillesMisesAJour) - 2)
    MsgBox "Les données ont été mises à jour avec succès dans les feuilles : " & feuillesMisesAJour, vbInformation
Else
    MsgBox "Aucune donnée n'a été mise à jour.", vbExclamation
End If

Bonjour,

Savez-vous qu'il est aussi possible d'utiliser dans une inputbox un objet Range?

Vous pourriez demander à l'utilisateur de sélectionner dans le classeur, la plage de dates à extraire (on peut utiliser CTRL pour prendre plusieurs plages) et ensuite on pourrait adapter la macro.

Si vous préférez garder la méthode d'entrée actuelle, on pourrait, plutôt que de tout relancer à la fin, demander au début à l'utilisateur s'il veut ajouter une autre plage :

C'est plus optimisé pour la macro, et surtout plus simple à coder.

Sinon, ce que vous voulez faire est aussi possible mais il faudrait joindre des fichiers d'exemple pour comprendre un peu la structure de vos données. Et je crois que vous avez oublié des lignes en haut du code de votre macro.