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
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