Copier/Coller cellules entre fichiers excel

Question

Bonjour, 
Je tente de créer une macro me permettant d'aller chercher des  lignes dans différents fichiers excel et de les recopier dans un fichier de destination. J'ai élaboré un début de macro mais mon pb est du fait que quand il va chercher le 2 ème fichier, cela les recopies sur les lignes du 1 er fichier et ainsi de suite... 
 
Je n'arrive pas à résoudre ce pb merci de m'aider. 
 
Cdlt 


Private Sub copiecollesave_Click()
Application.ScreenUpdating = False
Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
FichD = ActiveWorkbook.Name
FichS = "FA.xls"
Workbooks.Open Rep & FichS

With Workbooks(FichS)
        .Sheets("Feuil1" ).Range("A2:H65536" ).Copy _
            Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0)
        Workbooks(FichD).Save
        Workbooks(FichS).Close
End With

Application.ScreenUpdating = False
Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
FichD = ActiveWorkbook.Name
FichS = "SB.xls"
Workbooks.Open Rep & FichS

With Workbooks(FichS)

        .Sheets("Feuil1" ).Range("A2:H65536" ).Copy _
            Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0)
        Workbooks(FichD).Save
        Workbooks(FichS).Close


End With
Application.ScreenUpdating = True
           
Application.ScreenUpdating = False
Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
FichD = ActiveWorkbook.Name
FichS = "MJ.xls"
Workbooks.Open Rep & FichS

With Workbooks(FichS)

        .Sheets("Feuil1" ).Range("A2:H65536" ).Copy _
            Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0)
        Workbooks(FichD).Save
        Workbooks(FichS).Close

End With
Application.ScreenUpdating = True
           
           
           
           
End Sub

pilas31 · Answer

Bonjour,

J'ai l'impression qu'il y a deux problèmes. D'abord des instructions à l'intérieur des With .. End With qui ne doivent pas y être et ensuite la taille de la zone copiée (A2:H65536) qui ne peut  être collée que dans un fichier vide sinon la zone de collage n'est pas assez grande. Je propose de limiter la zone copier par exemple (A2:H1000).

J'ai fais les quelques corrections et simplifications :

Private Sub copiecollesave_Click() 
Application.ScreenUpdating = False
Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
FichD = ActiveWorkbook.Name
FichS = "FA.xls"
Workbooks.Open Rep & FichS
With Workbooks(FichS)
  .Sheets("Feuil1").Range("A2:H1000").Copy _
   Workbooks(FichD).Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0)
  .Close
End With

Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
FichS = "SB.xls"
Workbooks.Open Rep & FichS

With Workbooks(FichS)
  .Sheets("Feuil1").Range("A2:H1000").Copy _
   Workbooks(FichD).Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0)
  .Close
End With

Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
FichS = "MJ.xls"
Workbooks.Open Rep & FichS

With Workbooks(FichS)
  .Sheets("Feuil1").Range("A2:H1000").Copy _
  Workbooks(FichD).Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0)
  .Close
End With

Workbooks(FichD).Save
Application.ScreenUpdating = True

End Sub


A+

Copier/Coller cellules entre fichiers excel

1 réponse

Discussions similaires

Newsletters