Copier une ligne dans un fichier et la coller dans l'ensemble des fichiers

Bonjour,

J'ai créé un code qui ne fonctionne pas correctement. Son objectif était de récupérer la ligne 62 du fichier 1_6S_Ordo, puis de l'insérer dans toutes les feuilles débutant par un S majuscule dans l'ensemble des fichiers de mon dossier. Cependant, je rencontre un message d'erreur persistant indiquant que la méthode Range a échoué. Malgré mes efforts, je suis à court d'idées pour résoudre ce problème. Il est important de noter que la ligne copiée doit être collée au même emplacement dans chaque fichier, c'est-à-dire entre les lignes 61 et 62. (À noter : des données existent déjà aux lignes 61 et 62, donc une nouvelle ligne doit être insérée.)

Pourriez-vous m'aider à résoudre ce problème ?

Ci-dessous se trouve le code. J'ai pris soin de supprimer les informations sensibles :

Sub CopierCollerDansFeuillesS()
    Dim chemin As String
    Dim classeurSource As Workbook
    Dim wsSource As Worksheet
    Dim ligneSource As Range
    Dim fichier As String
    Dim classeurDestination As Workbook
    Dim wsDestination As Worksheet
    Dim ligneDestination As Range
    Dim derniereLigne As Long
    Dim i As Integer

    ' Chemin du dossier contenant les fichiers Excel
    chemin = "chemin\vers\mon\dossier\"

    ' Ouvre le fichier source à partir duquel la ligne sera copiée
    Set classeurSource = Workbooks.Open(chemin & "1_6S_Ordo.xlsx")

    ' Récupère la feuille et la ligne source à copier
    Set wsSource = classeurSource.Sheets("S02")
    Set ligneSource = wsSource.Rows(62)

    ' Parcourt tous les fichiers Excel dans le dossier spécifié
    fichier = Dir(chemin & "*.xlsx")
    Do While fichier <> ""
        ' Ouvre le fichier actuel dans la boucle
        Set classeurDestination = Workbooks.Open(chemin & fichier)

        ' Parcourt toutes les feuilles commencant par "S" majuscule
        For Each wsDestination In classeurDestination.Worksheets
            If Left(wsDestination.Name, 1) = "S" Then
                ' Insère une ligne en dessous de la ligne 61 de la feuille destination
                wsDestination.Rows(62).EntireRow.Insert
                ' Colle la ligne source dans la nouvelle ligne insérée
                ligneSource.Copy
                wsDestination.Rows(62).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
            End If
        Next wsDestination

        ' Ferme et enregistre le fichier sans modifications
        classeurDestination.Close SaveChanges:=False

        fichier = Dir
    Loop

    ' Ferme le fichier source
    classeurSource.Close SaveChanges:=False
End Sub

En vous remerciant par avance du temps que vous porterez à mon sujet,

Je vous souhaite une agréable journé
Cordialement
MikaG

Bonjour MickaG

Juste un petit oubli, tester que le fichier que l'on veut ouvrir n'est pas celui source

Sub CopierCollerDansFeuillesS()
  Dim chemin As String
  Dim classeurSource As Workbook
  Dim wsSource As Worksheet
  Dim ligneSource As Range
  Dim fichier As String
  Dim classeurDestination As Workbook
  Dim wsDestination As Worksheet
  Dim ligneDestination As Range
  Dim derniereLigne As Long
  Dim i As Integer

  ' Chemin du dossier contenant les fichiers Excel
  'chemin = "chemin\vers\mon\dossier\"
  chemin = ThisWorkbook.Path & "\SousDossier\"

  ' Ouvre le fichier source à partir duquel la ligne sera copiée
  Set classeurSource = Workbooks.Open(chemin & "1_6S_Ordo.xlsx")

  ' Récupère la feuille et la ligne source à copier
  Set wsSource = classeurSource.Sheets("S02")
  Set ligneSource = wsSource.Rows(62)

  ' Parcourt tous les fichiers Excel dans le dossier spécifié
  fichier = Dir(chemin & "*.xlsx")
  Do While fichier <> ""
    ' Ajout BrunoM45
    ' Vérifier qu'il ne s'agit pas du fichier source
    If fichier <> classeurSource.Name Then
      ' Ouvre le fichier actuel dans la boucle
      Set classeurDestination = Workbooks.Open(chemin & fichier)

      ' Parcourt toutes les feuilles commencant par "S" majuscule
      For Each wsDestination In classeurDestination.Worksheets
        If Left(wsDestination.Name, 1) = "S" Then
          ' Insère une ligne en dessous de la ligne 61 de la feuille destination
          wsDestination.Rows(62).EntireRow.Insert
          ' Colle la ligne source dans la nouvelle ligne insérée
          ligneSource.Copy
          wsDestination.Rows(62).PasteSpecial Paste:=xlPasteValues
          Application.CutCopyMode = False
        End If
      Next wsDestination

      ' Ferme et enregistre le fichier sans modifications
      classeurDestination.Close SaveChanges:=False
    End If

    fichier = Dir
  Loop

  ' Ferme le fichier source
  classeurSource.Close SaveChanges:=False
End Sub

A+