Bonjour le Forum,
Je me heurte à un problème qui pour vous sera je pense une formalité!
Je cherche à copier ce qui se trouve dans les cellules grisées et la verte (voir fichier joint) et coller le tout dans la feuille "enregistrement". J'arrive à faire le copier coller mais je n'arrive pas à coller à la ligne suivante qui est vide. Pour simplifier la sélection des données, je les ai rassemblées de i2 à m2.
J'ai trouvé plein de discussion sur le Forum mais je n'arrive pas à voir ce qu'il me manque.
Voici mon code:
Sub enregistre()
Dim Source As Range, destination As Range, ligne As Range
'feuille active
Set Source = ActiveSheet.Range("j2:n2")
With ThisWorkbook.Worksheets("enregistrement")
Set destination = .Range("a2:e2").End(xlUp)(2)
If destination.Row > 1 Or destination <> "" Then Set destination = destination.Offset(1, 0)
End With
For Each ligne In Source.Rows
If ligne.Cells(1, 1) <> "" Then
ligne.Copy
destination.PasteSpecial xlPasteValuesAndNumberFormats
Set destination = destination.Offset(2)
End If
Next ligne
Application.CutCopyMode = False
End Sub
Je vous remercie pour votre aide.
Guillaume
Je me heurte à un problème qui pour vous sera je pense une formalité!
Je cherche à copier ce qui se trouve dans les cellules grisées et la verte (voir fichier joint) et coller le tout dans la feuille "enregistrement". J'arrive à faire le copier coller mais je n'arrive pas à coller à la ligne suivante qui est vide. Pour simplifier la sélection des données, je les ai rassemblées de i2 à m2.
J'ai trouvé plein de discussion sur le Forum mais je n'arrive pas à voir ce qu'il me manque.
Voici mon code:
Sub enregistre()
Dim Source As Range, destination As Range, ligne As Range
'feuille active
Set Source = ActiveSheet.Range("j2:n2")
With ThisWorkbook.Worksheets("enregistrement")
Set destination = .Range("a2:e2").End(xlUp)(2)
If destination.Row > 1 Or destination <> "" Then Set destination = destination.Offset(1, 0)
End With
For Each ligne In Source.Rows
If ligne.Cells(1, 1) <> "" Then
ligne.Copy
destination.PasteSpecial xlPasteValuesAndNumberFormats
Set destination = destination.Offset(2)
End If
Next ligne
Application.CutCopyMode = False
End Sub
Je vous remercie pour votre aide.
Guillaume
Pièces jointes
Dernière édition: