Thread: [Solved] VBA code ajustment
View Single Post
 
Old 08-12-2018, 05:49 AM
Stefaan1973 Stefaan1973 is offline Windows 10 Office 2016
Novice
 
Join Date: Aug 2018
Posts: 3
Stefaan1973 is on a distinguished road
Default VBA code ajustment

hi everyone,

i have an vba code that works but i need adjustments

the sheets are made for driver to register their rides.
the vba code sorts the colom "Busjes" (busses) but there are serveral busses not sorted.
we have busje 1 til 6 but we also have mercedes 1 en mercedes 2 this to should be included in the vba macro

can anybody help me please?

here is the code

Sub VenA()
Application.ScreenUpdating = False
ar = Sheets("Voertuig").Cells(1).CurrentRegion
For j = 2 To UBound(ar)
If IsError(Evaluate("'" & ar(j, 1) & "'!A1")) Then Sheets.Add(Sheets(Sheets.Count)).Name = ar(j, 1)
Sheets(ar(j, 1)).Cells.Clear
Sheets(ar(j, 1)).Cells(1).Resize(, 9) = Split("Datum Soort_Rit Traject Busje Chauffeur Tankbeurt Km_Begin Km_Eind Aantal_KM")
Next j

For Each sh In Sheets(Array("Koen", "Stefaan", "Carlos", "Bartje", "Ronny", "Martial", "Emiel", "Bart", "Gilbert", "Sven", "Danny"))
For j = 2 To UBound(ar)
With sh.ListObjects(1).DataBodyRange
tel = WorksheetFunction.CountIf(sh.Range("D"), ar(j, 1))
If tel > 0 Then
.AutoFilter 4, ar(j, 1)
.Offset(0, 0).Resize(.Rows.Count - 1, 9).Copy
Sheets(ar(j, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial 12
.AutoFilter
End If
End With
Next j
Next sh

For j = 2 To UBound(ar)
With Sheets(ar(j, 1)).Cells(1).CurrentRegion
.Columns.AutoFit
'andere opmaak dingetjes
.Sort .Cells(1), , , , , , , xlYes

rij = Sheets(ar(j, 1)).Range("A:A").SpecialCells(xlCellTypeVisible).S pecialCells(xlCellTypeConstants).Count + 1
Sheets(ar(j, 1)).Range("i" & rij).Formula = "=SUM(i" & 2 & ":i" & rij - 1 & ")"

End With
Next j
End Sub

Last edited by Stefaan1973; 08-12-2018 at 05:54 AM. Reason: problem solved!!!
Reply With Quote