Archivage de cellule vers autre feuille
s
Bonjour,
je recherche le moyen d'archiver mes cellules colonne B feuille notes vers ma feuille présence vis a vis de la date
soit si lun 28 sept alors archiver cellule b3 vers cellule al4 sachant que le 1 doit correspondre u nom dans les 2 feuilles
en pièce jointe fichier en exemple
est-ce possible par formule ?
et en vba ne m'y connaissant que très peu je vais pas y arriver
besoin de vos lumières
merci
s
Bonjour,
j'ai avancé un petit peut sur mon fichier en effet ayant trouvé un code sur le site je l'ai adapté a mon fichier mais je bloque sur un point
en effet je peut archiver mes lignes sur ma feuill archivage, mais je n'arrive pas à trouver la façon de laisser les cellules de la colonne A sur la feuil entrainements, j'ai besoin quelles se copie sur archivage, et quelles reste sur entrainement (uniquement la colonne A)
est-ce possible ? si oui veut bien un coup de pouce
dsl le fichier ne veut pas se télécharger
Sub Reset_Ligne()
Dim c As Range, cDest As Range
Application.ScreenUpdating = False
With ThisWorkbook
'cDest: La celllule de destination: première cellule vide de la colonne A de Archivage
With .Worksheets("Archivage")
Set cDest = .Cells(.Rows.Count, "A").End(xlUp)(2)
End With
With .Worksheets("entrainements")
'on cherche LA CELLULE contenant x en colonne V de Feuille Planning
Set c = .Range("b:b").Find("1", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
With c.EntireRow
'On copie toute la ligne trouvée vers cDest
.Copy cDest
'on supprime la ligne trouvée de Feuil1
.Delete
End With
Set c = Nothing
End If
'on vide notre variable cDest
Set cDest = Nothing
End With
Sheets("Archivage").Select
Cells.FormatConditions.Delete
Columns("A:A").Select
Selection.Hyperlinks.Delete
With Selection
.VerticalAlignment = xlTop
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
Sheets("entrainements").Select
End Sub
Sub Transfert()
Dim LastLig As Long
Dim sDest As Worksheet ' Feuille de destination
Dim cDest As Range ' Cellule de destination
Dim lCount As Long ' Nombre de cellule copié
Dim lFirst As Long ' Premiere cellule de date
Application.ScreenUpdating = False
With ThisWorkbook
'cDest: La celllule de destination: première cellule vide de la colonne A de Feuil2
Set sDest = .Worksheets("Archivage")
Set cDest = sDest.Cells(sDest.Rows.Count, "A").End(xlUp)(2)
With .Worksheets("entrainements")
'Enlève l'éventuel filtre automatique
.AutoFilterMode = False
'LastLig, ligne de la dernière cellule remplie de colonne A de Archive
LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
'On fait un filtre automatique sur la colonne V de Planning avec comme critère "x"
.Range("B2:B" & LastLig).AutoFilter field:=1, Criteria1:="1"
'Si au moins une ligne résultat du filtre (en plus de la ligne 1 des titres)
lCount = .Range("B1:B" & LastLig).SpecialCells(xlCellTypeVisible).Count
If lCount > 1 Then
With .Range("B2:B" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow
'On copie toutes les lignes visibles vers cDest (sauf la ligne des titres)
.Copy cDest
'on supprime toutes les lignes visibles (sauf la ligne des titres)
.Delete
End With
' On récupère la première cellule de la copie
lFirst = cDest.Rows(0).Row
sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).Hyperlinks.Delete
sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).Font.Underline = False
sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).HorizontalAlignment = xlCenter
sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).Borders.Weight = xlThin
sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).VerticalAlignment = xlVAlignCenter
sDest.Range(sDest.Cells(lFirst, "P"), sDest.Cells(lFirst + (lCount - 1), "P")).HorizontalAlignment = xlCenter
sDest.Range(sDest.Cells(lFirst, "P"), sDest.Cells(lFirst + (lCount - 1), "P")).Borders.Weight = xlThin
sDest.Range(sDest.Cells(lFirst, "P"), sDest.Cells(lFirst + (lCount - 1), "P")).VerticalAlignment = xlVAlignCenter
End If
'on vide notre variable cDest
Set cDest = Nothing
'On enlève le filtre automatique
.AutoFilterMode = False
End With
End With
Sheets("Archivage").Select
Cells.FormatConditions.Delete
Columns("B:B").Select
Selection.Hyperlinks.Delete
Sheets("entrainements").Select
End Sub