Copie multicellules entre classeurs

[Pat2A]

Bonjour messieurs du forum.
J'utilise un code pour copier des cellules multiples qui fonctionne très bien tant que l'on reste dans le même classeur mais en l'adaptant pour copier sur un classeur différent ça bug.
J'ai le code d'erreur '1004': Erreur définie par l'application ou par l'objet.
L'erreur se porte sur la ligne de code d'erreur suivante:
ThisWorkbook.WorkSheets("C").Select
J'ouvre le classeur d'origine et je clique sur un bouton me permettant de copier différentes cellules d'un second classeur fermé et de
copier ces cellules au même endroit sur mon classeur d'origine.

CODE:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim wb as Workbook
Set wb = Workbooks.Open (Filename = "D:\Test\Classeur2.xls")
wb.WorkSheets("A").Select
wb.WorkSheets("A").Range ("A4:I17,A25:I30,A36:O40").Select
For Each cel In Selection
cel.Copy
ThisWorkbook.WorkSheets ("A").Select
Range (cel.Adress).Select
ActiveSheet.Paste
Next cel
wb.close
Application.ScreenUpdating = True
End Sub

Avez-vous une idée de la cause de ce problème?

Merci de votre attention.

 

[Dranreb]

Re : Copie multicellules entre classeurs

Bonjour.
Essayez comme ça :

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Wb As Workbook, Cel As Range
Set Wb = Workbooks.Open(Filename:="D:\Test\Classeur2.xls")
ThisWorkbook.Activate
For Each Cel In Wb.Worksheets("A").Range("A4:I17,A25:I30,A36:O40")
   Cel.Copy Destination:=ThisWorkbook.Worksheets("A").Range(Cel.Adress)
   Next Cel
Wb.Close
Application.ScreenUpdating = True
End Sub

Remarque: Le ThisWorkbook.Activate qui manquait n'est peut être quand même plus nécessaire.
À +

 

[Pat2A]

Re : Copie multicellules entre classeurs

Bonjour Dranreb,
Merci beaucoup cela fonctionne parfaitement même sans le " ThisWorkbook.Activate ".
Est-il possible avec cette méthode de ne copier que les valeurs pour que la procédure soit plus rapide? En réalité j'ai plusieurs milliers de cellules multiples à copier dans plusieurs classeurs.

Merci encore pour ta réponse rapide.

 

[Dranreb]

Re : Copie multicellules entre classeurs

Comme ça peut être :

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Wb As Workbook, Zon As Range
Set Wb = Workbooks.Open(Filename:="D:\Test\Classeur2.xls")
For Each Zon In Wb.Worksheets("A").Range("A4:I17,A25:I30,A36:O40").Areas
   ThisWorkbook.Worksheets("A").Range(Zon.Address).Value = Zon.Value
   Next Zon
Wb.Close
Application.ScreenUpdating = True
End Sub

 

[Pat2A]

Re : Copie multicellules entre classeurs

Super cela fonctionne parfaitement.
Merci

 

[Pat2A]

Re : Copie multicellules entre classeurs

Bonjour messieurs,
Je reviens sur ce sujet car ma zone de cellules à copier est de plus en plus grande et je suis obligé d'utiliser la fonction Union(Range... malheureusement ce n'est plus compatible avec For Each.
Y-a-t-il une solution pour contourner ce problème?
Merci de votre attention.

 

[Dranreb]

Re : Copie multicellules entre classeurs

Bonsoir.
Le For Each Zon In ExpressionRange.Areas devrait justement marcher si ExpressionRange est un résultat d'union.
Cela dit il vaudrait quand même mieux trouver une définition logique globale pour les cellules à copier du genre "toutes celles contenant une constante dans telle grande plage" ou quelque chose comme ça. Vous ne pouvez vraiment pas copier les valeurs d'au moins toute une une seule grande portion la feuille ? Ce serait bien plus rapide !
À +

 

[Pat2A]

Re : Copie multicellules entre classeurs

Bonjour Dranreb,
Merci de bien vouloir m'aider. En fait, je pourrai tout à fait réduire le nombre de cellules à seulement trois expressions si je savais comment ne copier que les cellules qui ne sont pas verrouillées et les recopier au même endroit sur ma feuille destinataire.
Je vais chercher dans ce sens mais n'hésite pas à m'aider si tu connais la solution.
Merci encore.

 

[Pat2A]

Re : Copie multicellules entre classeurs

Finalement, j'ai essayé ça et cela à l'air de fonctionner correctement:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Wb As Workbook, Cel As Range
Set Wb = Workbooks.Open(Filename:="D:\Test\Classeur2.xls")
For Each Cel In Wb.Worksheets("A").Range("A4:I17,A25:I30,A36:O40")
   If Cel.Locked = False Then 
      ThisWorkbook.Worksheets("A").Range(Cel.Address).Value = Cel.Value
   End If 
   Next Cel
Wb.Close SaveChanges:=False 
Application.ScreenUpdating = True
End Sub