Reporting découpage onglets
Bonjour à tous,
Je fais appel à vous car je rencontre des soucis avec la Macro Excel que j'ai créée pour automatiser la production d'un reporting mensuel.
Mon souci est le suivant, quand je passe à l'étape "découpage" la Macro ne découpe pas de manière exacte mes données.
Je m'explique, la Macro possède 2 onglets : Onglet 1 : "Créations" & Onglet 2 : "Suppressions". Ces onglets je les alimente à partir d'une extraction. Dans ces onglets j'ai toutes les créations et toutes les suppressions du mois antérieur pour tous les clients, puis je découpe par client. Le découpage doit regrouper dans 1 seul fichier les 2 onglets seulement avec les informations qui le concernent.
Quand j'ai des données pour le client X dans les deux onglets, le découpage s'effectue de manière exacte mais quand j'ai seulement des données dans l'onglet "Suppressions", la Macro semble être perdue… Elle créé seulement un onglet, notamment "Créations" et place les données de l'onglet "Suppressions". Ce qui est erroné!
Ce que je souhaite qu'elle fasse est : Quand le client X ne possède pas des données dans l'onglet "Créations" de passer à l'onglet "Suppressions" et de créer seulement celui-ci dans le fichier qu'elle va générer tout en reportant dans le nouveau fichier les données pour le client X.
Je vous attache le code de ma Macro dans un "Spoiler". J'espère avoir été suffisamment clair dans mes explications, si vous avez besoin de plus de précisions ou si je n'ai pas été assez clair, je reste à votre disponibilité. Je vous remercie pour votre aide. Bonne journée à vous.
Sub MYBYOD_DECOUPAGE()
Dim d As Object, wbk As Workbook, k, itm, kitm, kk, et, et2, f%, n%, i%, ch$, rw$
Set d = CreateObject("Scripting.Dictionary")
With ThisWorkbook
For f = 1 To .Worksheets.Count
With .Worksheets(f)
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To n
kitm = .Cells(i, 1)
k = "wb_" & kitm: itm = "ws" & f
If d.exists(k) Then
If InStr(d(k), itm) = 0 Then d(k) = d(k) & ";" & itm
Else
d(k) = ";" & itm
End If
k = itm & "_" & kitm: kitm = kitm & "_" & itm: itm = "rw" & i
If d.exists(k) Then
If InStr(d(k), itm) = 0 Then d(k) = d(k) & ";" & itm
Else
d(k) = ";" & itm
End If
kitm = kitm & itm: itm = .Cells(i, 1).Resize(, 16).Value
d(kitm) = itm
Next i
End With
Next f
et = .Worksheets(1).Range("A1:P1").Value
et2 = .Worksheets(2).Range("A1:P1").Value
ch = .Path & "\"
End With
Application.ScreenUpdating = False
For Each k In d.keys
If k Like "wb_*" Then
kitm = Split(k, "_")(1)
Set wbk = Workbooks.Add(xlWBATWorksheet)
wbk.SaveAs ch & "Reporting_MyByod_01-" & Month(Date) & "-" & Year(Date) & "_" & kitm & ".xlsx"
itm = Split(d(k), ";")
With wbk
Bonjour,
Le code que tu as joint ne semble pas complet.
Le plus simple, peut-être, serait de joindre une maquette de ton EXCEL.
Bonjour GVIALLES,
Je vous remercie pour votre réponse. Je n'ai pas fait attention et en effet il manque une partie du code.
Voici à nouveau le code, cette fois complet.
Sub MYBYOD_DECOUPAGE()
Dim d As Object, wbk As Workbook, k, itm, kitm, kk, et, et2, f%, n%, i%, ch$, rw$
Set d = CreateObject("Scripting.Dictionary")
With ThisWorkbook
For f = 1 To .Worksheets.Count
With .Worksheets(f)
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To n
kitm = .Cells(i, 1)
k = "wb_" & kitm: itm = "ws" & f
If d.exists(k) Then
If InStr(d(k), itm) = 0 Then d(k) = d(k) & ";" & itm
Else
d(k) = ";" & itm
End If
k = itm & "_" & kitm: kitm = kitm & "_" & itm: itm = "rw" & i
If d.exists(k) Then
If InStr(d(k), itm) = 0 Then d(k) = d(k) & ";" & itm
Else
d(k) = ";" & itm
End If
kitm = kitm & itm: itm = .Cells(i, 1).Resize(, 16).Value
d(kitm) = itm
Next i
End With
Next f
et = .Worksheets(1).Range("A1:P1").Value
et2 = .Worksheets(2).Range("A1:P1").Value
ch = .Path & "\"
End With
Application.ScreenUpdating = False
For Each k In d.keys
If k Like "wb_*" Then
kitm = Split(k, "_")(1)
Set wbk = Workbooks.Add(xlWBATWorksheet)
wbk.SaveAs ch & "Reporting_MyByod_01-" & Month(Date) & "-" & Year(Date) & "_" & kitm & ".xlsx"
itm = Split(d(k), ";")
With wbk
If UBound(itm) > 1 Then
For f = 2 To UBound(itm)
.Worksheets.Add after:=.Worksheets(f - 1)
Next f
End If
For f = 1 To UBound(itm)
kk = Split(d(itm(f) & "_" & kitm), ";"): n = 1
With .Worksheets(f)
If f = 1 Then .Cells(n, 1).Resize(, 16).Value = et
If f = 2 Then .Cells(n, 1).Resize(, 16).Value = et2
If f = 1 Then Sheets(1).Name = "Créations"
If f = 2 Then Sheets(2).Name = "Suppressions"
For i = 1 To UBound(kk)
n = n + 1
rw = kitm & "_" & itm(f) & kk(i)
.Cells(n, 1).Resize(, 16).Value = d(rw)
Next i
End With
Next f
.Close True
End With
End If
Set wbk = Nothing
Next k
End Sub
Dillinger,
Tel quel, ton code est bien difficile à suivre.
Je me permets quelques remarques générales suivantes dans le but de rendre un code VBA accessible à un tiers :
- utiliser l'indentation pour séparer les blocs de code dans les boucles FOR, les IfThenElse ou les with/Endwith...
- privilégier les déclarations explicites des variables plutôt que les déclarations "old school" avec les %,$...
- mettre un maximum de commentaires.
Un mot d'ordre: soyons explicites