Hallo Luc,

Als ik je hoofdblad bekijk dan zie ik veel landen met 2, 3 en meer keer het jaar 2026 in kolom B, dat wordt dus moeilijk zonder fouten te schrijven.

De macro  Sub RijenToevoegen()   vervangen door onderstaande code zorgt voor je G-kolom met de foto-nummers.
Sub RijenToevoegen()

    Dim lijst As Variant
    Dim i As Long
    Dim beginrij As Long
    Dim rngLand As Range
    Dim jaar As String
 
   ' Controle op aantal
    If Application.WorksheetFunction.Count(Blad2.Range("B2:B100")) = 0 Then
         If MsgBox("Je hebt geen aantal ingevuld. Toch doorgaan?", vbYesNo + vbExclamation, "Geen aantal") = vbNo Then
             Blad2.Activate
            Exit Sub
         End If
    End If
    ' Blad1 actief maken en filter wissen
    Blad1.Activate
With Blad1
    On Error Resume Next
    If .AutoFilterMode Then
        .ShowAllData
        .AutoFilterMode = False
    End If
    On Error GoTo 0
End With
 
    ' Lijst uit Blad2
    lijst = Blad2.Range("A2:B2500").Value

    With Blad1
        For i = 1 To UBound(lijst, 1)
            If Val(lijst(i, 2)) > 0 Then

     ' Laatste rij van dit land zoeken, ongeacht filter
                Set rngLand = .Columns(1).Find(What:=lijst(i, 1), LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
                If rngLand Is Nothing Then
                    MsgBox "Land '" & lijst(i, 1) & "' werd niet gevonden in Blad1.", vbExclamation, "Land ontbreekt"
                    Exit Sub
                End If

                beginrij = rngLand.Row + 1
               
                ' Volledige rijen invoegen (ongevoelig voor filter)
                .Rows(beginrij & ":" & beginrij + lijst(i, 2) - 1).Insert Shift:=xlDown
                ' Focus op de originele land-rij
                .Cells(rngLand.Row, 1).Select
                ' Landnaam + opmaak
                With .Cells(beginrij, 1).Resize(lijst(i, 2), 1)
                    .Value = lijst(i, 1)
                    .Font.Color = vbWhite
                End With

               'Kolom B en C leeg laten
                With .Cells(beginrij, 2).Resize(lijst(i, 2), 2)
                    .Value = ""
                        End With


                ' Kolommen D en E op 0
                With .Cells(beginrij, 4).Resize(lijst(i, 2), 2)
                    .Value = 0
                End With
                ' Kolom G doornummeren
                With .Cells(beginrij, 7).Resize(lijst(i, 2), 1)
                Dim nr As Long
                nr = rngLand.Offset(0, 6).Value + 1   ' nummer na de originele rij
                Dim k As Long
                For k = 1 To lijst(i, 2)
                    .Cells(k, 1).Value = nr
                        nr = nr + 1
                Next k
End With


            End If
        Next i
    End With

    Blad1.Visible = True
    Blad2.Visible = xlSheetHidden
    opmaak

End Sub
Succes.

SoftAid              

Luc, heb je rijen toegevoegd? Ik heb het hier getest, en de foto-nummers komen op de nieuwe rijen te staan (kolom G)

SoftAid