Copier/coller une cellule dans une autre avec boucle for each

[jerem512]

Bonjour,


Je vous explique ma problématique. J'ai un planning dans lequel je rassemble plusieurs projet.
Je souhaite copier/coller des cellules dans un autre planning si et seulement si la cellule en face est rempli.

J 'ai commencé à faire un code mais il ne fonctionne pas.

Le voici:


Sub PLANNING()
Dim WbkS As Workbook ' Classeur source
Dim WbkD As Workbook ' Classeur de Destination
Dim VPathFic As String
Dim Cell As Range

' Définir le classeur source
Set WbkS = ThisWorkbook

' Demander de choisir le classeur de Destination
MsgBox "Merci de sélectionner le classeur de Destination !"
' Choisir le fichier à ouvrir
VPathFic = ChoixFichier()
' Si aucun fichier, alors sortir
If VPathFic = "" Then Exit Sub
' Sinon ouvrir le classeur
Workbooks.Open VPathFic
' Définir le classeur de Destination
Set WbkD = ActiveWorkbook
' Effectuer la copie / collage de chaque feuille

For Each Cell In Range("A12:A" & Range("A500").End(xlUp).Row)
If Cell <> "" Then

WbkS.Sheets("Liste qui fait quoi").Cell.Offset(0, 1).Copy Destination:=WbkD.Sheets("Table").Range("A1")

End If
Next Cell

' Message de fin
MsgBox "La copie du classeur source vers le calsseur de destination est terminée"
' effacer les variables objet
Set WbkD = Nothing
Set WbkS = Nothing
End Sub
Function ChoixFichier()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
If .Show = -1 Then
ChoixFichier = fd.SelectedItems(1)
Else
ChoixFichier = ""
End If
End With
Set fd = Nothing
End Function


La ligne qui bloque est la suivante:
WbkS.Sheets("Liste qui fait quoi").Cell.Offset(0, 1).Copy Destination:=WbkD.Sheets("Table").Range("A1")

L 'erreur est: Erreur d’exécution 438

Également, actuellement ma macro ne fait la copie que sur une seule cellule ( Range("A1") ) seulement je voudrais qu'avec le "for each" la copie ce fasse en A1 puis B1 puis C1.

En espérant avoir un retour.
Merci

 

[Roland_M]

Re : Copier/coller une cellule dans une autre avec boucle for each

Bonjour,

ici pour avancer sur les colonnes mais toujours sur la ligne 1 donc !?
NoCol = 0
For Each Cell In Range("A12:A" & Range("A500").End(xlUp).Row)
If Cell <> "" Then NoCol = NoCol + 1: WbkS.Sheets("Liste qui fait quoi").Cell.Offset(0, 1).Copy Destination:=WbkD.Sheets("Table").Cells(1, NoCol)
Next Cell

quand à l'erreur as-tu bien vérifié les noms des onglets ?

 

[jerem512]

Re : Copier/coller une cellule dans une autre avec boucle for each

Bonjour,

Le décalage me convient pour autant j'ai toujours un soucis sur la ligne concerné:

J'ai toujours la même erreur.

J'ai fait un copié/collé des noms d'onglets. Je ne comprends pas le problème

: WbkS.Sheets("Liste qui fait quoi").Cell.Offset(0, 1).Copy Destination:=WbkD.Sheets("Table").Cells(1, NoCol)


Merci de ton retour

 

[thebenoit59]

Re : Copier/coller une cellule dans une autre avec boucle for each

Peux-tu envoyer ton fichier ?

 

[jerem512]

Re : Copier/coller une cellule dans une autre avec boucle for each

Bonjour,

Voici mon fichier,

Vous pouvez considérer le deuxième planning comme un classeur vierge contenant une feuille nommée Table

 

[Roland_M]

Re : Copier/coller une cellule dans une autre avec boucle for each

re

tu as fais une erreur ici
NoCol = 0
For Each Cell In Range("A12:A" & Range("A500").End(xlUp).Row)
If Cell <> "" Then
Nolig = Nolig + 1: WbkS.Sheets("Liste qui fait quoi").Cell.Offset(0, 1).Copy Destination:=WbkD.Sheets("Table").Cells(Nolig, 2)

tu as dis au départ de A1 puis B1 puis C1
ici tu mets en lig avec NoCol =0 !? c'est cohérent tout ça !?

si tu veux en ligne c'est différent et voir no de col !?
NoLig = 0
For Each Cell In Range("A12:A" & Range("A500").End(xlUp).Row)
If Cell <> "" Then NoLig = NoLig + 1: WbkS.Sheets("Liste qui fait quoi").Cell.Offset(0, 1).Copy Destination:=WbkD.Sheets("Table").Cells(NoLig, 1)
Next Cell


EDIT: revoir le code car modifié une erreur !

 

[jerem512]

Re : Copier/coller une cellule dans une autre avec boucle for each

Bonjour,

Désolé j'ai voulu essayer dans l'autre sens.

Cependant même avec nocol cela ne fonctionne pas.

 

[Roland_M]

Re : Copier/coller une cellule dans une autre avec boucle for each

re

ok, mais ton erreur ne vient pas de col ou lig !

 

[Roland_M]

Re : Copier/coller une cellule dans une autre avec boucle for each

re

essaies comme ceci
WbkS.Sheets("Liste qui fait quoi").Range(Cell.Address).Offset(0, 1).Copy

NoCol = 0
For Each Cell In Range("A12:A" & Range("A500").End(xlUp).Row)
If Cell <> "" Then NoCol = NoCol + 1: WbkS.Sheets("Liste qui fait quoi").Range(Cell.Address).Offset(0, 1).Copy Destination:=WbkD.Sheets("Table").Cells(1, NoCol)
Next Cell

mais il te faut revoir deux choses:
1 les lignes et colonnes de destination
2 dans la colonne A tu n'as rien !? ne serait-ce pas colonne B !?

 

[jerem512]

Re : Copier/coller une cellule dans une autre avec boucle for each

Bonjour,

Je pense m'être mal exprimé au départ.

Je réexplique donc:

Dans ma feuille "Liste qui fait quoi" j'ai en colonne A des cellules qui peuvent être rempli ou non
Si, par exemple, la case A1 est rempli je veux que la valeur B1 soit copier coller dans la feuille "table" en B1
Si non, rien

Puis, si la case A2 est rempli je veux que la valeur B2 soit copier coller dans la feuille "table" en B2

etc.... jusqu’à la dernière ligne complétement vide en considérant que je n'irais pas à plus de 500 lignes (je ne connais pas la formule pour dire "dernière ligne complétement vide"

Merci de m'aider

 

[Roland_M]

Re : Copier/coller une cellule dans une autre avec boucle for each

re

es-tu certain que c'est à partir de A1 !? ne serait-ce pas à partir de A12 ?

 

[jerem512]

Re : Copier/coller une cellule dans une autre avec boucle for each

Re,

Oui pardon, je ne suis pas assez précis. Mon exemple était général.

 

[Roland_M]

Re : Copier/coller une cellule dans une autre avec boucle for each

re

bon, je vais regardé à ça, si j'ai des questions je reviendrais !

 

[Roland_M]

Re : Copier/coller une cellule dans une autre avec boucle for each

re

bon si j'ai bien tout compris,
je boucle sur la colonne A à partir de la ligne 12 jusque la dernière occupée
si dans cette colonne A il y a une cellule occupée je copie la cellule d'en face soit en B
dans la même cellule de la feuille Table


tu essayes ce code à la place de la boucle actuelle !
mais une petite question, tu as cette remarque au début de la boucle
' Effectuer la copie / collage de chaque feuille
mais ici tu n'effectues que sur une feuille, non !?

' Effectuer la copie / collage de chaque feuille
DernLig& = Columns(1).Rows(Rows.Count).End(xlUp).Row
If DernLig >= 12 Then
   For Each Cell In Range("A12:A" & DernLig)
       If Cell <> "" Then
          R$ = Range(Cell.Address).Offset(0, 1).Address
          WbkS.Sheets("Liste qui fait quoi").Range(R$).Copy Destination:=WbkD.Sheets("Table").Range(R$)
       End If
   Next
End If
' Message de fin

EDIT: si tu ne veux copier que les valeurs alors tu prends celui-ci:
tu verras j'avais oublié ça> Application.CutCopyMode = False <tu peux le reprendre aussi !

' Effectuer la copie / collage de chaque feuille
DernLig& = Columns(1).Rows(Rows.Count).End(xlUp).Row
If DernLig >= 12 Then
   For Each Cell In Range("A12:A" & DernLig)
       If Cell <> "" Then
          R$ = Range(Cell.Address).Offset(0, 1).Address
          WbkS.Sheets("Liste qui fait quoi").Range(R$).Copy 'Destination:=WbkD.Sheets("Table").Range(R$)
          WbkD.Sheets("Table").Range(R$).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       End If
   Next
End If
Application.CutCopyMode = False
' Message de fin

 

[jerem512]

Re : Copier/coller une cellule dans une autre avec boucle for each

RE,

Je suis rentré chez moi et essayé sur excel 2013.

Est ce que cela incombe des modifications?

Car rien ne se copie?