macro reporting a etendre sur 5 colonnes

julie999

XLDnaute Occasionnel
bonjour
une personne du forum m'avait fabriquer une macro pour effectuer le reporting de la feuille "reception" vers la feuille "reporting"
cette macro fonctionne a merveille
par contre aujourd’huit il y a 5 colonnes de plus a remplir(couleur grise colonne BH:BL)
et malheureusement je ne suis pas spécialiste des macro
y aurait une personne pour me compléter la macro
merci Julie

voici la macro utilisé:
Sub Archive()
Application.ScreenUpdating = False
Worksheets("reporting").Visible = True
Sheets("reporting").Select
ActiveSheet.Unprotect "david"
Dim LigneEnCours As Long
Dim Données As Variant
'Détection 1° ligne utilisable
With Worksheets("reporting")

'Choix de la ligne de destination
LigneEnCours = .Range("B" & Rows.Count).End(xlUp).Row
If .Range("A" & LigneEnCours) = Worksheets("RECEPTION").Range("W2") Then
LigneEnCours = LigneEnCours - 2
Else
LigneEnCours = LigneEnCours + 1
End If
If LigneEnCours > 10 Then .Range("A8:BL10").Copy .Range("A" & LigneEnCours & ":BL" & LigneEnCours)

'Copie de la date
.Range("A" & LigneEnCours).Resize(3, 1) = Worksheets("RECEPTION").Range("W2")
'lieux de réception
.Range("B" & LigneEnCours) = "Sartrouville"
.Range("B" & LigneEnCours + 1) = "Londres"
.Range("B" & LigneEnCours + 2) = "Arvato"
'Cellules de regroupement
.Range("F" & LigneEnCours) = Worksheets("RECEPTION").Range("C74").Value
.Range("J" & LigneEnCours) = Worksheets("RECEPTION").Range("I74").Value
.Range("AI" & LigneEnCours) = Worksheets("RECEPTION").Range("X46").Value

'Sartrouville
Données = Worksheets("RECEPTION").Range("B8").Resize(1, 3).Value
.Range("C" & LigneEnCours).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("E8").Resize(1, 3).Value
.Range("G" & LigneEnCours).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("H8").Resize(1, 24).Value
.Range("K" & LigneEnCours).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("AB13").Resize(1, 4).Value
.Range("AJ" & LigneEnCours).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("B13").Resize(1, 20).Value
.Range("AN" & LigneEnCours).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("C106").Resize(1, 1).Value

'Londres
Données = Worksheets("RECEPTION").Range("B19").Resize(1, 3).Value
.Range("C" & LigneEnCours + 1).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("E19").Resize(1, 3).Value
.Range("G" & LigneEnCours + 1).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("H19").Resize(1, 24).Value
.Range("K" & LigneEnCours + 1).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("AB24").Resize(1, 4).Value
.Range("AJ" & LigneEnCours + 1).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("B24").Resize(1, 20).Value
.Range("AN" & LigneEnCours + 1).Resize(1, UBound(Données, 2)) = Données

'Arvato
Données = Worksheets("RECEPTION").Range("B30").Resize(1, 2).Value
.Range("BH" & LigneEnCours + 2).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("E30").Resize(1, 3).Value
.Range("G" & LigneEnCours + 2).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("H30").Resize(1, 24).Value
.Range("K" & LigneEnCours + 2).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("AB35").Resize(1, 4).Value
.Range("AJ" & LigneEnCours + 2).Resize(1, UBound(Données, 2)) = Données
Données = Worksheets("RECEPTION").Range("B35").Resize(1, 20).Value
.Range("AN" & LigneEnCours + 2).Resize(1, UBound(Données, 2)) = Données

End With



End Sub
 

Pièces jointes

  • Classeur test reporting.xlsm
    63.3 KB · Affichages: 59
  • Classeur test reporting.xlsm
    63.3 KB · Affichages: 61
  • Classeur test reporting.xlsm
    63.3 KB · Affichages: 63

Statistiques des forums

Discussions
312 300
Messages
2 087 000
Membres
103 429
dernier inscrit
PhilippeH