Bonjour à tous,
J'ai une programmation VBA qui me pose probleme.
Voila j'ai automatisé le quadrillage lorsque j'insere une nouvelle ligne dans mon tableau Excel.
Sauf que mon quadrillage s'arrete a la colonne I au lieu de la colonne J. Il y a par consequent je suis obliger faire le quadrillage automatique sur la colonne J manuellement.
Voici ma prog VBA:
Private Sub Worksheet_Activate()
Dim ws As Worksheet, fin&, fin1
Application.ScreenUpdating = 0
With Feuil1
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
.Range("A9:J" & fin).ClearContents
.Range("A9:J" & fin).Borders.LineStyle = 0
Feuil2.Rows(9).Copy .Rows(9)
.Range("A1") = "RECAPITULATIF DES RDV " & Right(.Name, 4)
For Each ws In Worksheets
If ws.Name <> "Tableau de Bord" And ws.Name <> "INFORMATION AGENCE" _
And Not ws.Name Like "RECAPITULATIF DES RDV" & "*" And ws.Name <> "RECAPITULATIF RDV PAR N°FICHE" Then
fin = .Range("A" & Rows.Count).End(xlUp).Row
fin1 = ws.Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
If fin1 <= 9 Then GoTo 1
ws.Range("A10:J" & fin1).Copy Feuil1.Range("A" & fin + 1)
End If
1 Next ws
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
.Range("A9:J" & fin).Borders.LineStyle = 1
.Columns("A:A").ColumnWidth = 13: .Columns("B:B").ColumnWidth = 8
.Columns("C:C").ColumnWidth = 15: .Columns("E:E").ColumnWidth = 33
.Columns("F:F").ColumnWidth = 40: .Columns("C:C").NumberFormat = "00"
.Columns("I:I").ColumnWidth = 50: .Columns("G:G").ColumnWidth = 35:
.Columns("H:H").ColumnWidth = 15:
.Range("A10:J" & fin).Sort Key1:=Range("A10"), Order1:=xlAscending, Header:=xlNo
End With
End Sub
Merci beaucoup
J'ai une programmation VBA qui me pose probleme.
Voila j'ai automatisé le quadrillage lorsque j'insere une nouvelle ligne dans mon tableau Excel.
Sauf que mon quadrillage s'arrete a la colonne I au lieu de la colonne J. Il y a par consequent je suis obliger faire le quadrillage automatique sur la colonne J manuellement.
Voici ma prog VBA:
Private Sub Worksheet_Activate()
Dim ws As Worksheet, fin&, fin1
Application.ScreenUpdating = 0
With Feuil1
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
.Range("A9:J" & fin).ClearContents
.Range("A9:J" & fin).Borders.LineStyle = 0
Feuil2.Rows(9).Copy .Rows(9)
.Range("A1") = "RECAPITULATIF DES RDV " & Right(.Name, 4)
For Each ws In Worksheets
If ws.Name <> "Tableau de Bord" And ws.Name <> "INFORMATION AGENCE" _
And Not ws.Name Like "RECAPITULATIF DES RDV" & "*" And ws.Name <> "RECAPITULATIF RDV PAR N°FICHE" Then
fin = .Range("A" & Rows.Count).End(xlUp).Row
fin1 = ws.Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
If fin1 <= 9 Then GoTo 1
ws.Range("A10:J" & fin1).Copy Feuil1.Range("A" & fin + 1)
End If
1 Next ws
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin < 9 Then fin = 9
.Range("A9:J" & fin).Borders.LineStyle = 1
.Columns("A:A").ColumnWidth = 13: .Columns("B:B").ColumnWidth = 8
.Columns("C:C").ColumnWidth = 15: .Columns("E:E").ColumnWidth = 33
.Columns("F:F").ColumnWidth = 40: .Columns("C:C").NumberFormat = "00"
.Columns("I:I").ColumnWidth = 50: .Columns("G:G").ColumnWidth = 35:
.Columns("H:H").ColumnWidth = 15:
.Range("A10:J" & fin).Sort Key1:=Range("A10"), Order1:=xlAscending, Header:=xlNo
End With
End Sub
Merci beaucoup