Créer une macro

Option Explicit

' constantes décrivant la configuration - à adapter

Public Const F1 = "Feuil4"
Public Const celdatF1 = "C2"
Public Const celnumF1 = "C6"
Public Const celvaaF1 = "C10"
Public Const celageF1 = "D10"
Public Const plagefF1 = "$A$20:$C$42"

Public Const F2 = "Feuil3"
Public Const covaaF2 = "A"
Public Const coageF2 = "B"
Public Const codesF2 = "C"
Public Const cocomF2 = "D"
Public Const coimeF2 = "E"
Public Const cobonF2 = "F"
Public Const codatF2 = "G"
Public Const comoiF2 = "H"
Public Const coannF2 = "I"

Public Sub Archiver()
Dim ligne As Long
Dim vaahiva As String, qte As Long, num As Long, dat, moi, ann
Dim nbdes As Long, codes As String, lides As Long, numdes As Long
' recupération des données feuille F1
With Sheets(F1)
  vaahiva = .RANGE(celvaaF1).Value
  num = .RANGE(celnumF1).Value
  dat = .RANGE(celdatF1).Value
  moi = Month(dat)
  ann = Year(dat)
  codes = Split(.RANGE(plagefF1).Address, "$")(1)
  lides = Left(Split(plagefF1, "$")(2), Len(Split(plagefF1, "$")(2)) - 1)
  nbdes = .RANGE(codes & Rows.Count).End(xlUp).Row - lides + 1
End With
' tranfer dans F2
With Sheets(F2)
  ' première ligne vide colonne A
  ligne = .RANGE(covaaF2 & Rows.Count).End(xlUp).Row + 1
  ' pour chaque designation
  For numdes = 1 To nbdes
    .RANGE(covaaF2 & ligne).Value = vaahiva
    .RANGE(coageF2 & ligne).Value = Sheets(F1).RANGE(plagefF1).Cells(numdes, 1).Value
    .RANGE(cocomF2 & ligne).Value = Sheets(F1).RANGE(plagefF1).Cells(numdes, 2).Value
    .RANGE(coimeF2 & ligne).Value = Sheets(F1).RANGE(plagefF1).Cells(numdes, 3).Value
    .RANGE(codatF2 & ligne).Value = dat
    .RANGE(comoiF2 & ligne).Value = moi
    .RANGE(coannF2 & ligne).Value = ann
    ligne = ligne + 1
  Next numdes
End With
End Sub