Copier / Coller ligne entre fichiers excel

Copier / Coller ligne entre fichiers excel - VB/VBA/VBS - Programmation

Marsh Posté le 14-05-2009 à 09:48:06    

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

Code :
  1. Private Sub copiecollesave_Click()
  2. Application.ScreenUpdating = False
  3. Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
  4. FichD = ActiveWorkbook.Name
  5. FichS = "FA.xls"
  6. Workbooks.Open Rep & FichS
  8. With Workbooks(FichS)
  9.         .Sheets("Feuil1" ).Range("A2:H65536" ).Copy _
  10.             Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0)
  11.         Workbooks(FichD).Save
  12.         Workbooks(FichS).Close
  13. End With
  15. Application.ScreenUpdating = False
  16. Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
  17. FichD = ActiveWorkbook.Name
  18. FichS = "SB.xls"
  19. Workbooks.Open Rep & FichS
  21. With Workbooks(FichS)
  23.         .Sheets("Feuil1" ).Range("A2:H65536" ).Copy _
  24.             Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0)
  25.         Workbooks(FichD).Save
  26.         Workbooks(FichS).Close
  29. End With
  30. Application.ScreenUpdating = True
  31.            
  32. Application.ScreenUpdating = False
  33. Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
  34. FichD = ActiveWorkbook.Name
  35. FichS = "MJ.xls"
  36. Workbooks.Open Rep & FichS
  38. With Workbooks(FichS)
  40.         .Sheets("Feuil1" ).Range("A2:H65536" ).Copy _
  41.             Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0)
  42.         Workbooks(FichD).Save
  43.         Workbooks(FichS).Close
  45. End With
  46. Application.ScreenUpdating = True
  47.            
  48.            
  49.            
  50.            
  51. End Sub

Reply

Marsh Posté le 14-05-2009 à 09:48:06   

Reply

Marsh Posté le 14-05-2009 à 09:57:00    

Il te manque un workbook(FichD).Activate ou qq chose du genre pour bien rendre actif ton fichier de destination.

Reply

Marsh Posté le 14-05-2009 à 12:46:51    

et je devrais le mettre ou?

Reply

Marsh Posté le 14-05-2009 à 13:04:09    

DTC ? :D
 
plus sérieusement, avant la ligne 40 !
 
bizarre ta ligne là d'ailleurs ? le collage, tu le fais surs FichD ? (D comme Destination) non ?? j'ai pas l'impression que ta ligne fasse ça en fait, d'où sûrement ton souci)
 
et ton "paste", tu n'en fais pas ?!???

Reply

Marsh Posté le 14-05-2009 à 16:24:22    

oui je fais le collage sur FichD et le collage marche pas le problème vient du fait que vu qu'il y a plusieurs fichiers à chaque fois ca écrit sur les lignes recopier de l'autre fichier, ca ne les mets pas à la suite.

Reply

Marsh Posté le 15-05-2009 à 09:38:07    

J'ai sûrement lu trop vite, alors du coup, pas bien sûr d'avoir saisi donc souci...
 
Tu pourrais reprendre ton code en le commentant pour dire ce que tu veux faire ?

Reply

Marsh Posté le 15-05-2009 à 16:17:36    

J'ai trouvé en changeant mon code
Cdlt  
merci de l'aide qd meme
 
 

Code :
  1. Sub Macro()
  3. 'Disons que tu places ta macro dans un fichier destination nommé Test.xls disposé sur le bureau ou autres que tu dois ouvrir pour la lancer
  4.     Dim FichD As String
  5.     Dim FichS As Long
  6.    
  7.     FichD = "Fichier_final.xls"
  9.     Application.ScreenUpdating = False
  10.     With Application.FileSearch
  11.         .NewSearch
  12.         .RefreshScopes
  13.         .LookIn = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\A\" 'Tous les fichiers du répertoire sont passés en revue
  14.         .Filename = "*.xls"
  15.         .SearchSubFolders = False
  16.         .Execute
  17.         For Ctr = 1 To .FoundFiles.Count
  18.             FichS = Ctr
  19.             Workbooks.Open (.FoundFiles(FichS)) 'Ouverture
  20.             Sheets("Feuil1" ).Range("A2:" & Range("H65536" ).End(xlUp).Address).Copy 'Copie
  21.             ActiveWorkbook.Close
  22.             Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0).Activate
  23.             ActiveSheet.Paste 'Collage
  24.         Next
  25.     End With
  26.     Range("A1" ).Activate
  27.     Application.CutCopyMode = False
  28.     Application.ScreenUpdating = True
  29.    
  30. End Sub

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed