Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

macro reporting a etendre sur 5 colonnes

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
836
Réponses
5
Affichages
780
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
652
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…