Hoe maak ik deze code korter?

[hellboy01]

Hi weet iemand misschien hoe ik deze blokken korter kan maken, liefst naar 1 blok, elementaire logica is niet echt mijn sterkste punt , alvast bedankt.

If CheckBox1 Then
            
            Worksheets("Boekclub").Select
            erow = Sheets("Boekclub").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            Cells(erow, 1) = ComboBox1.Text
            Cells(erow, 2) = TextBox2.Text
            Cells(erow, 3) = TextBox3.Text
            Cells(erow, 4) = TextBox4.Text
            Cells(erow, 5) = TextBox5.Text
            'TextBox6.Text = Format(TextBox6.Text, "dd/mmm/yyyy")
            Cells(erow, 6) = Date
            
            Worksheets("Main Database").Select
            erow = Sheets("Main Database").Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
            Cells(erow, 8) = "ja"
            Cells(erow, 8).Interior.ColorIndex = 3
            
        
        End If
        
        If CheckBox2 Then
            
            Worksheets("Tennis").Select
            erow = Sheets("Tennis").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            Cells(erow, 1) = ComboBox1.Text
            Cells(erow, 2) = TextBox2.Text
            Cells(erow, 3) = TextBox3.Text
            Cells(erow, 4) = TextBox4.Text
            Cells(erow, 5) = TextBox5.Text
            'TextBox6.Text = Format(TextBox6.Text, "dd/mmm/yyyy")
            Cells(erow, 6) = Date
            
            Worksheets("Main Database").Select
            erow = Sheets("Main Database").Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
            Cells(erow, 9) = "ja"
        
        End If
        
        If CheckBox3 Then
            
            Worksheets("Gitaar").Select
            erow = Sheets("Gitaar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            Cells(erow, 1) = ComboBox1.Text
            Cells(erow, 2) = TextBox2.Text
            Cells(erow, 3) = TextBox3.Text
            Cells(erow, 4) = TextBox4.Text
            Cells(erow, 5) = TextBox5.Text
            'TextBox6.Text = Format(TextBox6.Text, "dd/mmm/yyyy")
            Cells(erow, 6) = Date
            
            Worksheets("Main Database").Select
            erow = Sheets("Main Database").Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
            Cells(erow, 10) = "ja"
        
        End If
        
        If CheckBox4 Then
            
            Worksheets("Keyboard").Select
            erow = Sheets("Keyboard").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            Cells(erow, 1) = ComboBox1.Text
            Cells(erow, 2) = TextBox2.Text
            Cells(erow, 3) = TextBox3.Text
            Cells(erow, 4) = TextBox4.Text
            Cells(erow, 5) = TextBox5.Text
            'TextBox6.Text = Format(TextBox6.Text, "dd/mmm/yyyy")
            Cells(erow, 6) = Date
            
            Worksheets("Main Database").Select
            erow = Sheets("Main Database").Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
            Cells(erow, 11) = "ja"
        
        End If
        
        If CheckBox5 Then
            
            Worksheets("Vrijwilligerswerk").Select
            erow = Sheets("Vrijwilligerswerk").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            Cells(erow, 1) = ComboBox1.Text
            Cells(erow, 2) = TextBox2.Text
            Cells(erow, 3) = TextBox3.Text
            Cells(erow, 4) = TextBox4.Text
            Cells(erow, 5) = TextBox5.Text
            'TextBox6.Text = Format(TextBox6.Text, "dd/mmm/yyyy")
            Cells(erow, 6) = Date
            
            Worksheets("Main Database").Select
            erow = Sheets("Main Database").Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
            Cells(erow, 12) = "ja"
        
        End If

 

[edmoor]

Zonder je document kan ik het niet testen, maar kijk eens naar dit:

Sub tst()
    If CheckBox1 Then Call HandleSheet("Boekclub", 8)
    If CheckBox2 Then Call HandleSheet("Tennis", 9)
    If CheckBox3 Then Call HandleSheet("Gitaar", 10)
    If CheckBox4 Then Call HandleSheet("Keyboard", 11)
    If CheckBox5 Then Call HandleSheet("Vrijwilligerswerk", 12)
End Sub

Sub HandleSheet(sht As String, rgl As Long)
    Dim erow As Long
    
    With Sheets(sht)
        erow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        .Cells(erow, 1) = ComboBox1.Text
        .Cells(erow, 2) = TextBox2.Text
        .Cells(erow, 3) = TextBox3.Text
        .Cells(erow, 4) = TextBox4.Text
        .Cells(erow, 5) = TextBox5.Text
        [COLOR="#008000"]'.TextBox6.Text = Format(TextBox6.Text, "dd/mmm/yyyy")[/COLOR]
        .Cells(erow, 6) = Date
        
        With Sheets("Main Database")
            erow = .Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
            .Cells(erow, rgl) = "ja"
        End With
        If sht = "Boekclub" Then .Cells(erow, 8).Interior.ColorIndex = 3
    End With
End Sub

 

[HSV]

Ook een poging uit de losse pols.

dim sh as object, i as long
for i = 1 to 5
If me("CheckBox" & i) Then
 set sh =  sheets(choose(i, "boekclub","tennis", "gitaar","keyboard","Vrijwilligerswerk"))  
     Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).resize(,6) = array(ComboBox1,TextBox2.value,TextBox3.value,TextBox4.value,TextBox5.value,date)
       with Sheets("Main Database").Cells(Rows.Count, 1).End(xlUp)
         .offset(,i+6) = "ja"
         .offset(i+6).Interior.ColorIndex = 3
      end with        
 End If
next i

 

[hellboy01]

Hi Edmoor en HSV, beide codes werken, hardstikke bedankt en weer wat geleerd. mvg Rob