Re : Macro s'éxécutant ou pas selon l'onglet actif
Bonsoir à tous,
J'ai crié victoire trop tôt 🙁 :
Quand je lance la macro dans son intégralité avec l'onglet "consosite" actif tout va bien. Lorsque l'onglet actif est "Données" la macro s'exécute sur cet onglet et ravage ma base de données.
J'ai pourtant bien essayé de préciser les onglets dans le code mais ça n'est pas efficace...Je vous soumets mon code:
Sub Consositeintégrale()
Workbooks("Stat-site.xls").Worksheets("Consosite").Cells.Delete
Workbooks("Stat-site.xls").Worksheets("Données").Range("A1:L" & Worksheets("Données").Range("A65536").End(xlUp).Row).Copy Worksheets("Consosite").Range("A1")
With Workbooks("Stat-site.xls").Worksheets("Consosite")
Rows("1").EntireRow.Delete
End With
'Hauteur de ligne= 20
With Workbooks("Stat-site.xls").Worksheets("Consosite")
Cells.Select
Selection.RowHeight = 20
End With
Rows("1:1").Select
'Insertion de 2 lignes
Selection.Insert Shift:=xlDown
Rows("1:1").Select
Selection.Insert Shift:=xlDown
'Collage de "D3" en "B1"
Range("D3").Copy Range("B1")
With Selection.Font
.Name = "Arial"
.Size = 24
.ColorIndex = xlAutomatic
.Bold = True
End With
'''''
'Sélection et suppression des colonnes C D E F G H I
Range("C:C,D😀,E:E,F:F,G:G,H:H,I:I").Select
Range("I1").Activate
Selection.Delete Shift:=xlToLeft
''''''''''''''''''''''''''''''''''''
'Addition et suppression des doublons
For Each Cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
For i = 1 To Range("A65536").End(xlUp).Row
Set Rng = Cell.Offset(i, 0)
If Rng <> "" And Rng = Cell Then
Range("A" & Cell.Row).Select
ligne = Cell.Row
' ajout des valeurs de la colonne D lors d'une détection de doublons
Cells(ligne, 3).Value = Cells(ligne, 3).Value + Cells(ligne + i, 3).Value
' suppression de la ligne en doublons
Range(Cells(ligne + i, 1), Cells(ligne + i, 5)).Delete
'Ajouter à la liste
' sortie de la boucle
i = i - 1
End If
Next i
Next Cell
''''''''''''''''''''''''''''''''''''''''''''
'Insertion colonne B + convertion et formatage
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(3, 1))
Columns("B:B").Select
Selection.NumberFormat = "000"
''''''''''''''''''''''''''''''''''''''''''''
'Insertion de la ligne 1
Rows("3:3").Select
Selection.Insert Shift:=xlDown
'Copie et collage des en-têtes de colonne ligne 1
Sheets("Modèle").Range("A1:G1").Copy Sheets("Consosite").Range("A3")
'Copie et collage de la formule en F4
Sheets("Modèle").Range("F2").Copy Sheets("Consosite").Range("F4")
'Recopie de la formule contenue en "E4" jusqu'à la dernière ligne
Range("F4:F" & Range("A65536").End(xlUp).Row).FillDown
'Ajustement des colonnes B,C,D
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D😀").EntireColumn.AutoFit
'Redimmensionne les colonnes E et F
Columns("E:E").ColumnWidth = 9#
Columns("F:F").ColumnWidth = 9#
'Alignement col A à droite et col B à gauche
Columns("A:A").Select
Range("A2").Activate
With Selection
.HorizontalAlignment = xlGeneral
End With
With Selection
.HorizontalAlignment = xlRight
End With
Columns("B:B").Select
Range("B2").Activate
With Selection
.HorizontalAlignment = xlLeft
End With
'Fusion et centrage de "A1"
Range("A1:F1").Select
With Selection
Rows("1:1").RowHeight = 60
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
Range("A1:E1").Select
With Selection.Interior
.ColorIndex = 33
.Pattern = xlSolid
End With
End With
'Mise en forme de A1 à F1
Range("A1:F1").Select
With Selection.Font
.Name = "Arial"
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection.Interior
.ColorIndex = 5
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
'Bordure colonnes A et B
Range("A4:B" & Range("A65536").End(xlUp).Row).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'Redimensionne la colonne A
Columns("A:A").ColumnWidth = 14#
'Redimensionne la ligne 3
Rows("3:3").RowHeight = 50
'''''''''''''''''''''
'Sélectionne de A3 et F3 jusqu'à la dernière ligne non vide
Range("A3:F" & Range("A65536").End(xlUp).Row).Select
'Déclenche le sous total
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'Alignement vertical
Range("A4:F" & Range("A65536").End(xlUp).Row).Select
With Selection
.VerticalAlignment = xlCenter
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Font.ColorIndex = 5
End Sub
