Code voor alle tabbladen in workbook laten gelden

[gl3nn1987]

Ik heb de volgende code voor sheets 1 gemaakt. Hoe zorg ik ervoor dat deze voor alle sheets geldt?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Sheets(1).AutoFilterMode = False
Dim c As Range
Dim g As Integer
g = Sheets(1).Range("E65536").End(xlUp).Row
For i = g To 1 Step -1

If Sheets(1).Range("D" & i) = "" Or Sheets(1).Range("E" & i) = "Amount" Then
Sheets(1).Range("A" & i).EntireRow.Delete
End If
Next


Sheets(1).Range("a1").EntireRow.Insert
Sheets(1).Range("A1:I1").AutoFilter
With Sheets(1).Range("a1")

.Offset(0, 0) = "Date"
.Offset(, 1) = "Account"
.Offset(, 2) = "Name"
.Offset(, 3) = "TC"
.Offset(, 4) = "Amount"
.Offset(, 5) = "D/C"
.Offset(, 6) = "Description"
.Offset(, 7) = "County"
.Offset(, 8) = "Name"
.Resize(, 9).Font.Bold = True
.Resize(, 9).Interior.ColorIndex = 15
End With
With Sheets(1).Range("E" & Range("E65536").End(xlUp).Row)
.Offset(1, 0).FormulaR1C1 = "=SUBTOTAL(9,R[-" & Sheets(1).Range("E65536").End(xlUp).Row & "]C:R[-2]C)"
.Offset(1, -2) = "SUBTOTAAL"
.Offset(1, -2).Resize(, 3).Font.Bold = True



End With
Sheets(1).Range("A1:A" & Sheets(1).Range("A65536").End(xlUp).Row).RowHeight = 15
Sheets(1).Columns("A:A").ColumnWidth = 15
Sheets(1).Columns("C:C").ColumnWidth = 50
Sheets(1).Columns("D:D").ColumnWidth = 10
Sheets(1).Columns("E:E").ColumnWidth = 15
Sheets(1).Columns("F:F").ColumnWidth = 7

End Sub

 

[Niels28]

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Sh.AutoFilterMode = False
Dim c As Range
Dim g As Integer
With Sh
g = .Range("E65536").End(xlUp).Row
For i = g To 1 Step -1

If .Range("D" & i) = "" Or .Range("E" & i) = "Amount" Then
.Range("A" & i).EntireRow.Delete
End If
Next
.Range("a1").EntireRow.Insert
.Range("A1:I1").AutoFilter
With .Range("a1")
.Resize(1, 9).Value = Array("Date", "Account", "Name", "TC", "Amount", "D/C", "Description", "County", "Name")
.Resize(, 9).Font.Bold = True
.Resize(, 9).Interior.ColorIndex = 15
End With
With .Range("E" & Range("E65536").End(xlUp).Row)
.Offset(1, 0).FormulaR1C1 = "=SUBTOTAL(9,R[-" & .Range("E65536").End(xlUp).Row & "]C:R[-2]C)"
.Offset(1, -2) = "SUBTOTAAL"
.Offset(1, -2).Resize(, 3).Font.Bold = True
End With
.Range("A1:A" & .Range("A65536").End(xlUp).Row).RowHeight = 15
.Columns("A:A").ColumnWidth = 15
.Columns("C:C").ColumnWidth = 50
.Columns("D:D").ColumnWidth = 10
.Columns("E:E").ColumnWidth = 15
.Columns("F:F").ColumnWidth = 7
End With

End Sub

Niels

 

[gl3nn1987]

Niels bedankt voor het snelle antwoord maar als ik jouw code overneem gebeurd er niks na dubbelklik

 

[Niels28]

Je moet hem wel achter thisworkbook zetten ipv achter het blad.

Niels

 

[gl3nn1987]

ahh sorry mijn fout.

Overigens 1 klein foutje erinstaan. bij Formula r1c1 moest nog sh.range ipv .range.

Maar reuze bedankt.

 

[Niels28]

Valt toch mee met een code die je niet kent , niet kunt testen en zonder voorbeeld

Niels