Bonjour ,
dans un fichier j'ai cette macro , qui me permet de transposer les infos ( saisie via un userform SAISIE )d'un onglet "semaine" ( colonne A= "code " et les colonnes suivante= des noms ") vers l'onglet "année" en modifiant les paramètres soit ( colonne A= les noms et les autre colonnes= les codes ), j'ai essayé de modifier la macro pour permettre de transposer les infos de l'onglet "année" vers l'onglet semaine ( en gros que le travail puisse se faire dans les deux sens )
mais sans sucées ( cela m'efface tout ) si quelqu'un peut m'aider s'il vous plait .
je joint le fichier
merci beaucoup
Private Sub TRANSPOSER_Click()
Dim Lig, Col, LastCol, LastAdr
Dim Plg, Plg2 As Range
Dim Cel, Cell, mNom
Dim C, D
Dim Sem, Ann As Worksheet
Dim Mlig, Mcol, Mdate, Mpause, Ligne
Lig = 4: Col = 1
Set Sem = Sheets("semaine"): Set Ann = Sheets("annee")
LastCol = Ann.Cells.Find("*", [A4], SearchDirection:=xlPrevious).Column
LastAdr = Ann.Cells.Find("*", [A4], SearchDirection:=xlPrevious).Address(0, 0)
Set Plg = Sheets("semaine").Range("B5:OI28") ' & LastAdr)
For Each Cel In Plg
If Not Cel = "" Then
Mcol = Cel.Column: Mdate = Cells(Lig, Mcol): Mpause = Cells(Cel.Row, 1): mNom = Cel.Value
' trouver mpause et mdate dans l'autre onglet (anneee)
With Sheets("ANNEE").Range("nom")
Set C = .Find(What:=mNom, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
Ligne = C.Row ' scanner la ligne des dates
For Each Cell In [dates]
If Cell.Value = Mdate Then
Mcol = Cell.Column
Ann.Cells(Ligne, Mcol) = Mpause
Exit For
End If
Next
End If
End With
End If
Next
End Sub
dans un fichier j'ai cette macro , qui me permet de transposer les infos ( saisie via un userform SAISIE )d'un onglet "semaine" ( colonne A= "code " et les colonnes suivante= des noms ") vers l'onglet "année" en modifiant les paramètres soit ( colonne A= les noms et les autre colonnes= les codes ), j'ai essayé de modifier la macro pour permettre de transposer les infos de l'onglet "année" vers l'onglet semaine ( en gros que le travail puisse se faire dans les deux sens )
mais sans sucées ( cela m'efface tout ) si quelqu'un peut m'aider s'il vous plait .
je joint le fichier
merci beaucoup
Private Sub TRANSPOSER_Click()
Dim Lig, Col, LastCol, LastAdr
Dim Plg, Plg2 As Range
Dim Cel, Cell, mNom
Dim C, D
Dim Sem, Ann As Worksheet
Dim Mlig, Mcol, Mdate, Mpause, Ligne
Lig = 4: Col = 1
Set Sem = Sheets("semaine"): Set Ann = Sheets("annee")
LastCol = Ann.Cells.Find("*", [A4], SearchDirection:=xlPrevious).Column
LastAdr = Ann.Cells.Find("*", [A4], SearchDirection:=xlPrevious).Address(0, 0)
Set Plg = Sheets("semaine").Range("B5:OI28") ' & LastAdr)
For Each Cel In Plg
If Not Cel = "" Then
Mcol = Cel.Column: Mdate = Cells(Lig, Mcol): Mpause = Cells(Cel.Row, 1): mNom = Cel.Value
' trouver mpause et mdate dans l'autre onglet (anneee)
With Sheets("ANNEE").Range("nom")
Set C = .Find(What:=mNom, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
Ligne = C.Row ' scanner la ligne des dates
For Each Cell In [dates]
If Cell.Value = Mdate Then
Mcol = Cell.Column
Ann.Cells(Ligne, Mcol) = Mpause
Exit For
End If
Next
End If
End With
End If
Next
End Sub
