Hey Ex-lid,
Ben je hier nu een oplossing aan het zoeken voor een probleem dat je zelf voor iemand anders probeert op te lossen? In elk geval tref ik hier een structuur aan die niet van jouw hand lijkt te zijn...
Een paar zaken zie ik toch al meteen: als je in beide werkbladen "Resultaat..." kolom D en in werkblad "JAP 2020" kolom A als tekst definieert heb je al een probleem minder.
Er staan 2 macro's die duidelijk de ene na de andere en in vaste volgorde moeten uitgevoerd worden. Dan kan je beide codes toch gewoon onder elkaar plakken (?) en nog enkele lijntjes weglaten.
Al een beetje opgeschoond (met de nadruk op 'een beetje'):
Private Sub Cmd1_Click()
Set R1 = Sheets("Resultaten")
Set R2 = Sheets("Resultaten (2)")
Set J20 = Sheets("JAP 2020")
lrR1 = R1.Cells(R1.Cells.Rows.Count, 4).End(xlUp).Row
For i = 9 To lrR1
lrJ20 = J20.Cells(J20.Cells.Rows.Count, 1).End(xlUp).Row + 1
If R1.Range("G" & i).Value = "x" Or R1.Range("G" & i).Value = "X" Then
J20.Range("A" & lrJ20).Value = R1.Range("D" & i).Value
J20.Range("B" & lrJ20).Value = R1.Range("E" & i).Value
End If
Next i
lrR2 = R2.Cells(R2.Cells.Rows.Count, 4).End(xlUp).Row
For i = 9 To lrR2
lrJ20 = J20.Cells(J20.Cells.Rows.Count, 1).End(xlUp).Row + 1
If R2.Range("G" & i).Value = "x" Or R2.Range("G" & i).Value = "X" Then
J20.Range("A" & lrJ20).Value = R2.Range("D" & i).Value
J20.Range("B" & lrJ20).Value = R2.Range("E" & i).Value
End If
Next i
J20.UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
End Sub
Blijft nog enkel de 'ontbrekende onderwerpen' denk ik dan. Maar nu even geen tijd meer, dus ik kom er later wel op terug. Laat je het wel weten mocht je die ondertussen zelf goed hebben gekregen?
Groeten,
pitufo