Copier/Coller cellules entre fichiers excel

Fermé

Nairolf87 - 14 mai 2009 à 13:06
pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 - 15 mai 2009 à 01:12

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

A voir également:

Copier/Coller cellules entre fichiers excel
Liste déroulante excel - Guide
Excel additionner des cellules - Guide
Copier coller pdf - Guide
Verrouiller cellules excel - Guide
Formule excel - Guide

1 réponse

Réponse 1 / 1

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
15 mai 2009 à 01:12

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+

Discussions similaires

Dessiner avec son clavier et avec des lettres

recopier une formule sans décalage

Discussions similaires

Newsletters