Alimenter une feuille avec deux autres feuilles en VBA
a
Bonjour a tous
Je vous explique mon problème j’espère que vous pourriez m'aider.
Voila j'ai une macro qui me permet d'alimenter une feuille avec deux autres feuilles.
Mon problème c'est que je ne comprend pas trop la macro et je dois l'utiliser pour alimenter d'autre fichiers mais qui ne sont pas au même format que le premier, du coup j'aimerais bien comprendre la macro pour savoir ceux que je dois changer et l'utiliser a nouveaux.
Merci beaucoup pour votre patience et votre aide
voici le code:
Sub vv()
Application.ScreenUpdating = False
'Détermintation de la cellule active pour la réactiver à la fin
Set wbBook = ThisWorkbook
ongletAct = ActiveWorkbook.ActiveSheet.Name
ligneAct = ActiveCell.Row
colonneAct = ActiveCell.Column
If ongletAct = "SOUSCRIPTIONS" Then Exit Sub
If ongletAct = "RETRACTATIONS" Then Exit Sub
For i = 1 To Worksheets.Count
Worksheets(i).Activate
'Définition du nom de l'onglet RETRACTATIONS
With ActiveSheet.Range(Cells(1, 1), Cells(30, 30))
Set c = .Find("RETRACTATIONS", LookIn:=xlValues)
If Not c Is Nothing Then
ActiveSheet.Name = "RETRACTATIONS"
With wbBook
Set wsRet = .Worksheets("RETRACTATIONS")
End With
End If
End With
'Définition du nom de l'onglet SOUSCRIPTIONS
With ActiveSheet.Range(Cells(1, 1), Cells(30, 30))
Set c = .Find("SOUSCRIPTIONS", LookIn:=xlValues)
If Not c Is Nothing Then
ActiveSheet.Name = "SOUSCRIPTIONS"
With wbBook
Set wsSou = .Worksheets("SOUSCRIPTIONS")
End With
End If
End With
Next i
'Recherche de la ligne de titres sur l'onglet RETRACTATIONS
Sheets("RETRACTATIONS").Select
With Sheets("RETRACTATIONS").Range(Cells(1, 1), Cells(30, 30))
Set c = .Find("REFERENCE", LookIn:=xlValues)
If Not c Is Nothing Then
LigTitreRet = c.Row
ColTitreRet = c.Column
End If
End With
'Détermination du périmètre des flux l'onglet RETRACTATIONS
NbreLignesRet = Sheets("RETRACTATIONS").Cells(LigTitreRet, 2).CurrentRegion.Rows.Count
NbreColonnesRet = Sheets("RETRACTATIONS").Cells(LigTitreRet, 2).CurrentRegion.Columns.Count
For i = 1 To NbreColonnesRet
If StrComp(Cells(LigTitreRet, i).Value, "REFERENCE", vbTextCompare) = 0 Then colRefRet = Columns(i).Column
If StrComp(Cells(LigTitreRet, i).Value, "NBRE" & Chr(10) & "DE MOIS", vbTextCompare) = 0 Then colNbMoisRet = Columns(i).Column
If StrComp(Cells(LigTitreRet, i).Value, "NB DE " & Chr(10) & "VENTES", vbTextCompare) = 0 Then colNbVtesRet = Columns(i).Column
If StrComp(Cells(LigTitreRet, i).Value, "COTIS. TOTALES " & Chr(10) & "TTC", vbTextCompare) = 0 Then colCotTTCRet = Columns(i).Column
Next
'Recherche de la ligne de titres sur l'onglet SOUSCRIPTIONS
Sheets("SOUSCRIPTIONS").Select
With ActiveSheet.Range(Cells(1, 1), Cells(30, 30))
Set c = .Find("REFERENCE", LookIn:=xlValues)
If Not c Is Nothing Then
LigTitreSou = c.Row
ColTitreSou = c.Column
End If
End With
'Détermination du périmètre des flux l'onglet SOUSCRIPTIONS
NbreLignesSou = ActiveSheet.Cells(LigTitreSou, 2).CurrentRegion.Rows.Count
NbreColonnesSou = ActiveSheet.Cells(LigTitreSou, 2).CurrentRegion.Columns.Count
For i = 1 To NbreColonnesSou
If StrComp(Cells(LigTitreSou, i).Value, "REFERENCE", vbTextCompare) = 0 Then colRefSou = Columns(i).Column
If StrComp(Cells(LigTitreSou, i).Value, "NBRE" & Chr(10) & "DE MOIS", vbTextCompare) = 0 Then colNbMoisSou = Columns(i).Column
If StrComp(Cells(LigTitreSou, i).Value, "NB DE " & Chr(10) & "VENTES", vbTextCompare) = 0 Then colNbVtesSou = Columns(i).Column
If StrComp(Cells(LigTitreSou, i).Value, "COTIS. TOTALES " & Chr(10) & "TTC", vbTextCompare) = 0 Then colCotTTCSou = Columns(i).Column
Next
'Suppression des espaces dans la colonne Reference
Sheets("RETRACTATIONS").Select
ActiveSheet.Range(Cells(LigTitreRet + 1, ColTitreRet), Cells(NbreLignesRet + LigTitreRet - 1, ColTitreRet)).Replace " ", ""
ActiveSheet.Range(Cells(LigTitreRet + 1, ColTitreRet), Cells(NbreLignesRet + LigTitreRet - 1, ColTitreRet)).Replace Chr(10), ""
Sheets("SOUSCRIPTIONS").Select
ActiveSheet.Range(Cells(LigTitreSou + 1, ColTitreSou), Cells(NbreLignesSou + LigTitreSou - 1, ColTitreSou)).Replace " ", ""
ActiveSheet.Range(Cells(LigTitreSou + 1, ColTitreSou), Cells(NbreLignesSou + LigTitreSou - 1, ColTitreSou)).Replace Chr(10), ""
'Début recherche existence Reference Ret dans Reference Sou
Worksheets("SOUSCRIPTIONS").Cells(LigTitreSou, NbreColonnesSou + 3).Value = "RETRACTATIONS"
For i = LigTitreSou + 1 To NbreLignesSou + LigTitreSou - 1
If Not IsError(Application.VLookup(Worksheets("SOUSCRIPTIONS").Cells(i, ColTitreSou), Worksheets("RETRACTATIONS").Range("C:AE"), 12, False)) Then
Worksheets("SOUSCRIPTIONS").Cells(i, NbreColonnesSou + 3).Value = Application.VLookup(Worksheets("SOUSCRIPTIONS").Cells(i, ColTitreSou), Worksheets("RETRACTATIONS").Range("C:AE"), 12, False)
Worksheets("SOUSCRIPTIONS").Cells(i, ColTitreSou).Interior.ColorIndex = 36
Else
Worksheets("SOUSCRIPTIONS").Cells(i, NbreColonnesSou + 1).Value = ""
Worksheets("SOUSCRIPTIONS").Cells(i, ColTitreSou).Interior.ColorIndex = xlColorIndexNone
End If
Next
'Début recherche existence Reference Sou dans Reference Ret
Worksheets("RETRACTATIONS").Cells(LigTitreRet, NbreColonnesRet + 3).Value = "SOUSCRIPTIONS"
For i = LigTitreRet + 1 To NbreLignesRet + LigTitreRet - 1
If Not IsError(Application.VLookup(Worksheets("RETRACTATIONS").Cells(i, ColTitreRet), Worksheets("SOUSCRIPTIONS").Range("C:AE"), 12, False)) Then
Worksheets("RETRACTATIONS").Cells(i, NbreColonnesRet + 3).Value = Application.VLookup(Worksheets("RETRACTATIONS").Cells(i, ColTitreRet), Worksheets("SOUSCRIPTIONS").Range("C:AE"), 12, False)
Worksheets("RETRACTATIONS").Cells(i, ColTitreRet).Interior.ColorIndex = 36
Else
Worksheets("RETRACTATIONS").Cells(i, NbreColonnesRet + 1).Value = ""
Worksheets("RETRACTATIONS").Cells(i, ColTitreRet).Interior.ColorIndex = xlColorIndexNone
End If
Next
'Recherche de la ligne de titres sur l'onglet ICI
Sheets(ongletAct).Select
With Sheets(ongletAct).Range(Cells(1, 1), Cells(30, 30))
Set c = .Find("REFERENCE", LookIn:=xlValues)
If Not c Is Nothing Then
LigTitreICI = c.Row
ColTitreICI = c.Column
End If
End With
'Détermination du périmètre des flux l'onglet ICI
NbreLignesICI = Sheets(ongletAct).Cells(LigTitreICI, ColTitreICI).CurrentRegion.Rows.Count
NbreColonnesICI = Sheets(ongletAct).Cells(LigTitreICI, ColTitreICI).CurrentRegion.Columns.Count
For i = 1 To NbreColonnesICI
If StrComp(Cells(LigTitreICI, i).Value, "NB DE VENTES", vbTextCompare) = 0 Then colNbSou = Columns(i).Column
If StrComp(Cells(LigTitreICI, i).Value, "NB DE RECTRACTATIONS", vbTextCompare) = 0 Then colNbRet = Columns(i).Column
If StrComp(Cells(LigTitreICI, i).Value, "TOTAL TTC", vbTextCompare) = 0 Then colMtTTC = Columns(i).Column
If StrComp(Cells(LigTitreICI, i).Value, "ND ADHESIONS", vbTextCompare) = 0 Then colNbAdh = Columns(i).Column
If StrComp(Cells(LigTitreICI, i).Value, "COMMISSONS DISTRIBUTEUR", vbTextCompare) = 0 Then colComDist = Columns(i).Column
If StrComp(Cells(LigTitreICI, i).Value, "PV TTC", vbTextCompare) = 0 Then colPxTTC = Columns(i).Column
If StrComp(Cells(LigTitreICI, i).Value, "PV HT", vbTextCompare) = 0 Then colPxHT = Columns(i).Column
If StrComp(Cells(LigTitreICI, i).Value, "TCA", vbTextCompare) = 0 Then colTCA = Columns(i).Column
Next
For i = LigTitreICI + 1 To NbreLignesICI + LigTitreICI - 1
Worksheets(ongletAct).Cells(i, colMtTTC).Value = 0
'Début recherche existence Reference ICI dans Reference Sou
If Not IsError(Application.VLookup(Worksheets(ongletAct).Cells(i, ColTitreICI), Worksheets("SOUSCRIPTIONS").Range("C:AZ"), colNbVtesSou, False)) Then
Worksheets(ongletAct).Cells(i, colNbSou).Value = Application.VLookup(Worksheets(ongletAct).Cells(i, ColTitreICI), Worksheets("SOUSCRIPTIONS").Range("C:AZ"), colNbVtesSou - colRefSou + 1, False)
Worksheets(ongletAct).Cells(i, colMtTTC).Value = Worksheets(ongletAct).Cells(i, colMtTTC).Value + Application.VLookup(Worksheets(ongletAct).Cells(i, ColTitreICI), Worksheets("SOUSCRIPTIONS").Range("C:AZ"), colCotTTCSou - colRefSou + 1, False)
Else
Worksheets(ongletAct).Cells(i, colNbSou).Value = ""
End If
'Début recherche existence Reference ICI dans Reference Ret
If Not IsError(Application.VLookup(Worksheets(ongletAct).Cells(i, ColTitreICI), Worksheets("RETRACTATIONS").Range("C:AZ"), colNbVtesRet, False)) Then
Worksheets(ongletAct).Cells(i, colNbRet).Value = Application.VLookup(Worksheets(ongletAct).Cells(i, ColTitreICI), Worksheets("RETRACTATIONS").Range("C:AZ"), colNbVtesRet - colRefRet + 1, False) * -1
Worksheets(ongletAct).Cells(i, colMtTTC).Value = Worksheets(ongletAct).Cells(i, colMtTTC).Value + Application.VLookup(Worksheets(ongletAct).Cells(i, ColTitreICI), Worksheets("RETRACTATIONS").Range("C:AZ"), colCotTTCRet - colRefRet + 1, False)
Else
Worksheets(ongletAct).Cells(i, colNbRet).Value = ""
End If
Next
End Sub