Code:
Private Sub CommandButton1_Click()
Dim lRij As Long, c As Range, iWS As Integer
Application.ScreenUpdating = False
For iWS = 1 To 5
With Sheets(Choose(iWS, "Zuid West", "Zuid Oost", "West", "Noord Oost", "LVO"))
Application.Union(.[7:25], .[29:47], .[51:69]).ClearContents
End With
Next
For Each c In [UMG!D11:D100]
On Error Resume Next
If c.Offset(, 2).Value = "Bedrijfsapplicatie" Then lRij = Sheets(c.Value).[B28].End(xlUp).Row + 1
If c.Offset(, 2).Value = "Kantoorapplicatie" Then lRij = Sheets(c.Value).[B50].End(xlUp).Row + 1
If c.Offset(, 2).Value = "Systeemapplicatie" Then lRij = Sheets(c.Value).[B72].End(xlUp).Row + 1
If c.Offset(, -1).Value = "Landelijk" Then
For iWS = 1 To 5
If c.Offset(, 2).Value = "Bedrijfsapplicatie" Then lRij = Sheets(Choose(iWS, "Zuid West", "Zuid Oost", "West", "Noord Oost", "LVO")).[B28].End(xlUp).Row + 1
If c.Offset(, 2).Value = "Kantoorapplicatie" Then lRij = Sheets(Choose(iWS, "Zuid West", "Zuid Oost", "West", "Noord Oost", "LVO")).[B50].End(xlUp).Row + 1
If c.Offset(, 2).Value = "Systeemapplicatie" Then lRij = Sheets(Choose(iWS, "Zuid West", "Zuid Oost", "West", "Noord Oost", "LVO")).[B72].End(xlUp).Row + 1
Range("A" & c.Row & ":Z" & c.Row).Copy Sheets(Choose(iWS, "Zuid West", "Zuid Oost", "West", "Noord Oost", "LVO")).Range("A" & lRij)
Next
Else
Range("A" & c.Row & ":Z" & c.Row).Copy Sheets(c.Value).Range("A" & lRij)
End If
Next
Application.ScreenUpdating = True
End Sub
Bij de optie landelijk schrijft hij alles weg naar meerdere tabbladen, nu wil ik dat dit ook gebeurd als de optie SBC is gekozen, maar ik krijg het niet verwerkt. Iemand een idee?