VBA code werkt nog niet goed

Status
Niet open voor verdere reacties.
C

ChantalM

Gebruiker
Lid geworden
4 jul 2018
Berichten
32
De VBA code die ik heb vult nu alleen de eerste cel die voldoet aan de voorwaarde.
Ik wil dat die ook de andere cellen vult die aan de voorwaarde voldoen.

verder moet de gehele code herhaalt worden voor cel A2 t/m A54
alleen moeten dan ook andere cellen worden gekopieerd D2 en F2 t/m D54 en F54.

kan iemand me hier mee helpen?


Code: 
Sub A2_medespeler()

Dim ii, i As Integer
For ii = 6 To 18
    For i = 2 To 54
        If Range("A" & i) = "" Then Exit Sub
        If Range("A2") = Sheets("Overzicht partijen mix").Range("D" & ii) Or Range("A2") = Sheets("Overzicht partijen mix").Range("E" & ii) Or Range("A2") = Sheets("Overzicht partijen mix").Range("F" & ii) Then
        If Sheets("Overzicht partijen mix").Range("D" & ii) = Range("A" & i) Or Sheets("Overzicht partijen mix").Range("E" & ii) = Range("A" & i) Or Sheets("Overzicht partijen mix").Range("F" & ii) = Range("A" & i) Then
        Worksheets("Toernooi Overzicht").Select
        Sheets("Toernooi Overzicht").Range("D2").Copy
        Range("D" & i).PasteSpecial
        Sheets("Toernooi Overzicht").Range("F2").Copy
        Range("F" & i).PasteSpecial
        End If
        End If
    Next i
Next ii

End Sub
 
Een niet werkend stuk code plaatsen is natuurlijk het proberen waard. Echter een bestand ( met fictieve persoonsgegevens :))met daarin wat uitleg over hoe en wat zou ook wel fijn zijn.
 
hoi,

hierbij het bestand.
Bekijk bijlage programma goed test.xlsm

Als je op het tabblad Toernooi Overzicht een stand invult in cel D2 - F2.
en dan de code uitvoert uit bovenstaand bericht dan vult die bij 1 medespeler de stand in.
maar als er een derde medespeler is vult die daarbij geen stand in, maar wil dat daar dan ook een stand wordt ingevuld.

Code: 
Sub A2_medespeler()

Dim ii, i As Integer
For ii = 6 To 18
    For i = 2 To 54
        If Range("A" & i) = "" Then Exit Sub
        If Range("A2") = Sheets("Overzicht partijen mix").Range("D" & ii) Or Range("A2") = Sheets("Overzicht partijen mix").Range("E" & ii) Or Range("A2") = Sheets("Overzicht partijen mix").Range("F" & ii) Then
        If Sheets("Overzicht partijen mix").Range("D" & ii) = Range("A" & i) Or Sheets("Overzicht partijen mix").Range("E" & ii) = Range("A" & i) Or Sheets("Overzicht partijen mix").Range("F" & ii) = Range("A" & i) Then
        Worksheets("Toernooi Overzicht").Select
        Range("D2").Select
       Application.CutCopyMode = False
    Selection.Copy
    Range("D" & i).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("E" & i).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F" & i).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        End If
        End If
    Next i
Next ii


End Sub

Code: 
Sub A3_tegenspelers()

Dim ii, i As Integer
For ii = 6 To 18
    For i = 2 To 54
        If Range("A" & i) = "" Then Exit Sub
        If Range("A2") = Sheets("Overzicht partijen mix").Range("D" & i) Or Range("A2") = Sheets("Overzicht partijen mix").Range("E" & ii) Or Range("A2") = Sheets("Overzicht partijen mix").Range("F" & ii) Then
        If Sheets("Overzicht partijen mix").Range("G" & ii) = Range("A" & i) Or Sheets("Overzicht partijen mix").Range("H" & ii) = Range("A" & i) Or Sheets("Overzicht partijen mix").Range("I" & ii) = Range("A" & i) Then
        Worksheets("Toernooi Overzicht").Select
        Range("D2").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("F" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("F2").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("D" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("E2").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("E" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        End If
        End If
    Next i
Next ii

End Sub
 
Dan gaat deze dicht
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan