Déplacer et recopier des éléments variables
Résolu
Bonjour,
Mon problème est le suivant : dans un tableau où figurent des noms de salariés et les heures effectuées par chacun, donc des informations variables (les noms changent et le nombre de lignes par salarié n'est jamais le même), je souhaite récupérer des informations de la colonne A pour les déplacer en colonne B, et les recopier sur plusieurs lignes.
Par exemple, j'ai besoin de recopier la cellule A1 en B5 et sur 10 lignes, et puis, la cellule A15 en B18 sur 15 lignes, etc...
Mon seul repère : les lignes vides entre les différents noms.
Je lance un SOS aux spécialistes VBA car je sèche lamentablement. Pour l'instant je ne recopie que le même nom sur l'ensemble du tableau !
Je joins un bout du fichier pour que ce soit plus clair.
Un grand merci à ceux qui auront pitié de moi !
Sub Copier_NOM()
Range("A1").Select
Selection.Cut
Range("B5").Select
ActiveSheet.Paste
Dim ligne
For i = 1 To 500
If Cells(i, "B") = "" Then
If Cells(i, "A") <> "" Then Cells(i, "b") = Cells(ligne, "b")
Else
ligne = i
End If
Next
End Sub
Mon problème est le suivant : dans un tableau où figurent des noms de salariés et les heures effectuées par chacun, donc des informations variables (les noms changent et le nombre de lignes par salarié n'est jamais le même), je souhaite récupérer des informations de la colonne A pour les déplacer en colonne B, et les recopier sur plusieurs lignes.
Par exemple, j'ai besoin de recopier la cellule A1 en B5 et sur 10 lignes, et puis, la cellule A15 en B18 sur 15 lignes, etc...
Mon seul repère : les lignes vides entre les différents noms.
Je lance un SOS aux spécialistes VBA car je sèche lamentablement. Pour l'instant je ne recopie que le même nom sur l'ensemble du tableau !
Je joins un bout du fichier pour que ce soit plus clair.
Un grand merci à ceux qui auront pitié de moi !
Sub Copier_NOM()
Range("A1").Select
Selection.Cut
Range("B5").Select
ActiveSheet.Paste
Dim ligne
For i = 1 To 500
If Cells(i, "B") = "" Then
If Cells(i, "A") <> "" Then Cells(i, "b") = Cells(ligne, "b")
Else
ligne = i
End If
Next
End Sub
2 réponses
-
ModérateurSalut,
Pour t'aider, il faudrait que tu nous communiques un fichier sans données confidentielles.
Pour cela, utilises un site de pièce jointe comme https://www.cjoint.com/
Tu va sur ce site créer un lien vers ton fichier et reviens coller ce lien dans une réponse. -
Merci beaucoup !
J'ai mis un fichier test en lien
Cordialement
http://cjoint.com/?AIDqzWIeBqx-
ModérateurLa macro ListerNomsEnColonneB est dans le module4 de ton fichier.
Le code :
Sub ListerNomsEnColonneB() Dim LigDep As Long, LigFin As Long, DrLig As Long, Lig As Long Dim Noms As String With Sheets("test") 'cas particulier du 1er nom en A1 Noms = .Range("A1").Value LigDep = .Range("A1").End(xlDown).Row + 1 LigFin = .Range("A" & LigDep).End(xlDown).Row For Lig = LigDep To LigFin .Cells(Lig, 2) = Noms Next DrLig = .Range("A" & Rows.Count).End(xlUp).Row 'pour les autres noms Do Lig = .Range("A" & LigFin).End(xlDown).Row LigDep = .Range("A" & Lig).End(xlDown).Row LigFin = .Range("A" & LigDep).End(xlDown).Row Noms = .Cells(Lig, 1).Value For Lig = LigDep To LigFin .Cells(Lig, 2) = Noms Next Loop While LigFin <> DrLig End With End Sub -
-
