wegschrijven data lukt niet volledig

[bowlingman]

Hallo,
Heb mijn progje voor de euromillions aangepast met nog 2 extra sheets.
De bedoeling is dat de data via het frm worden weggeschreven naar de 3 verschillende sheets.
Namelijk "EuromillionsPersoonlijk", "EuromillionsPost" en "EuromillionsBowling"
Ik wou dit via de volgende code doen

Private Sub cmbWegschrijven_Click()
Dim Rw1 As Integer, i As Integer, TB As Object

       With Sheets("EuromillionsPersoonlijk")
            Rw1 = .Range("B108").End(xlUp).Row + 1
                For Each TB In Me.Controls
                    For i = 1 To 20
                            If TB.Name = "TextBox" & i Then
                            With .Cells(Rw1, i + 2)
                                .Value = TB.Value
                            End With
                                With .Cells(Rw1, 2)
                                    .Value = Calendar1.Value
                                End With
                                    TB.Value = ""
                            End If
                    Next
                Next
        End With
        
       With Sheets("EuromillionsPost")
            Rw1 = .Range("B108").End(xlUp).Row + 1
                For Each TB In Me.Controls
                    For i = 1 To 20
                            If TB.Name = "TextBox" & i Then
                            With .Cells(Rw1, i + 2)
                                .Value = TB.Value
                            End With
                                With .Cells(Rw1, 2)
                                    .Value = Calendar1.Value
                                End With
                                    TB.Value = ""
                            End If
                    Next
                Next
        End With
        
        With Sheets("EuromillionsBowling")
            Rw1 = .Range("B108").End(xlUp).Row + 1
                For Each TB In Me.Controls
                    For i = 1 To 20
                            If TB.Name = "TextBox" & i Then
                            With .Cells(Rw1, i + 2)
                                .Value = TB.Value
                            End With
                                With .Cells(Rw1, 2)
                                    .Value = Calendar1.Value
                                End With
                                    TB.Value = ""
                            End If
                    Next
                Next
        End With
        
End Sub

Hiermee wordt de data netjes weggeschreven naar "EuromillionsPersoonlijk", maar naar de andere 2 sheets wordt enkel de datum weggeschreven en niet de value van txt's

De link naar mijn progje is http://www.mijnbestand.nl/Bestand-GGGLPCN4PYRE.xlsm
Grtjs.
Armand

 

[trucker10]

Wat doet dit stukje code ?

End With
                                    TB.Value = ""
                            End If

zet daar eens quotes ( ' ) voor in "EuromillionsPersoonlijk" en "EuromillionsPost"

 

[bowlingman]

Bedankt Trucker10 voor de snelle reactie

Een beetje te snel geweest.
Had er niet bij stil gestaan dat na de eerste TB.value="" de textboxen dan al leeg waren en er dus ook geen data meer kon weggeschreven worden.
Heb deze in beide gedeeltes van de code verwijderd, zodat dit nog alleen bij "EuromillionsBowling" staat en nu wordt alles wel correct weggeschreven

Grtjs.
Armand

 

[trucker10]

Eventueel red je het met 1 code

with Sheets(array("EuromillionsPersoonlijk", "EuromillionsPost" ,"EuromillionsBowling
 ")

 

[Warme bakkertje]

Voor mij volstaat dit.

Private Sub cmbWegschrijven_Click()
    Dim data(8), i As Integer, j As Integer
    data(0) = Calendar1.Value
    For i = 1 To 7
        data(i) = Me("TextBox" & i).Value
    Next
    For j = 1 To 3
        Sheets(Choose(j, "EuromillionsPersoonlijk", "EuromillionsPost", "EuromillionsBowling")).Range("B108").End(xlUp).Offset(1).Resize(, 8) = data
    Next
End Sub

 

[bowlingman]

Hallo Trucker10 en Warm Bakkertje,

Ik had deze middag ook al aan het klooien geweest met "Array's"

Private Sub cmbWegschrijven_Click()
Dim Rw1 As Integer, i As Integer, TB As Object
        With Sheets(Array("EuromillionsPersoonlijk", "EuromillionsPost", "EuromillionsBowling"))
            [COLOR="#FF0000"]Rw1 = .Range("B108").End(xlUp).Row + 1[/COLOR]
                For Each TB In Me.Controls
                    For i = 1 To 20
                            If TB.Name = "TextBox" & i Then
                            With .Cells(Rw1, i + 2)
                                .Value = TB.Value
                            End With
                                With .Cells(Rw1, 2)
                                    .Value = Calendar1.Value
                                End With
                                    TB.Value = ""
                            End If
                    Next
                Next
        End With
End Sub

maar krijg steeds op de rode regel een foutmelding dat de eigenschap of methode niet wordt ondersteund door het object.
De code van Warm Bakkertje werkt ook perfect wat het wegschrijven van de data betreft, maar waar en hoe zet ik daar bij in dat de txt's na het wegschrijven van de data terug leeg zijn.

 

[HierEnNu]

Zoiets?

Private Sub cmbWegschrijven_Click()
    Dim data(8), i As Integer, j As Integer
    data(0) = Calendar1.Value
    For i = 1 To 7
        data(i) = Me("TextBox" & i).Value
    Next
    For j = 1 To 3
        Sheets(Choose(j, "EuromillionsPersoonlijk", "EuromillionsPost", "EuromillionsBowling")).Range("B108").End(xlUp).Offset(1).Resize(, 8) = data
    Next
    [COLOR="#FF0000"]For Each ctl In frmEuromillions.Controls
        If TypeName(ctl) = "TextBox" Then
            ctl.Value = vbNullString
        end if
    next ctl[/COLOR]
End Sub

 

[bowlingman]

Ga ik morgen proberen

 

[bowlingman]

Voila sé,
Dank zij de onbaatzuchtige hulp van de andere, werkt mijn progje voor de euromillions perfect.
Na al de verschillende voorstellen heb ik de volgende code samengesteld.

Private Sub cmbWegschrijven_Click()
    Dim data(21), i As Integer, j As Integer
        data(0) = Calendar1.Value
            For i = 1 To 20
                data(i) = Me("TextBox" & i).Value
            Next
        For j = 1 To 3
            Sheets(Choose(j, "EuromillionsPersoonlijk", "EuromillionsPost", "EuromillionsBowling")).Range("B108").End(xlUp).Offset(1).Resize(, 21) = data
        Next
        For Each ctl In frmEuromillions.Controls
            If TypeName(ctl) = "TextBox" Then
                ctl.Value = ""
            End If
        Next
End Sub

Hopelijk hebben andere gebruikers hier nog iets aan.

Hartelijk dank aan de helpers.
Grtjs.
Armand