Automatisk opdatering fra et ark til andre ark

Ja - det er ikke noget problem.

Du er velkommen til sende et filen eller model/uddrag heraf. @-adresse undern min profil.

Er de relevante "nationsark" oprettet på forhånd eller..

og så velkommen til Eksperten..

Indtil videre er "nationsarkene" ikke lavet, da jeg ikk var sikker på det var muligt!! Men jeg kan lige få lavet excel-filen, med de nødvendige "nationsark" og så sende den til dig..

Skal jeg også have lagt alle kunde dataen ind, eller kan du godt bare lave koden uden disse er lagt ind endnu?? Altså kan lave nogle overordnede overskrifter, så du ved hvordan dataen kommer til at ligge i det ark..

Det er ok med nationsark & overskrifter - men gerne lige et par "dummy kunder".

Kan der komme flere nationer, end dem du opretter. Det kan også lade sig gøre via VBA-koden?

Rem version 2
Rem =========
Dim antalRækker As Long, landekode As String, ræk As Long
Dim ræk1 As Long                                    'første række i kundedata

Const fraKolonne = "A"                              '<-- kan justeres
Const tilKolonne = "A"                              '<-- kan justeres

Const rækx = 7                                      'første række Nationsark
Public Sub fordelPåLandekoder()
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem hentværdi til første række, der skal behandles i næste kørsel
    ræk1 = Range("F1")
   
    For ræk = ræk1 To antalRækker
        landekode = Range("D" & ræk)
        If landekode <> "" Then
            Range(fraKolonne & ræk & ":" & tilKolonne & ræk).Select
            Selection.Copy
            If findesLandeKode(landekode) = True Then
               
                flytTilLandeKoden
            Else
                MsgBox "Landekode: " & landekode & " findes ikke"
            End If
        End If
    Next ræk
   
Rem opdater sidst behandlede række+1
    Range("F1") = ræk
End Sub
Private Function findesLandeKode(landekode)
On Error GoTo landeKodeMangler
    Sheets(landekode).Activate
    findesLandeKode = True
    Exit Function
   
landeKodeMangler:
    findesLandeKode = False
End Function
Private Sub flytTilLandeKoden()
Dim ræk
    For ræk = rækx To 65000
        If ActiveSheet.Range("A" & ræk) = "" Then
            ActiveSheet.Range("A" & ræk).Select
            ActiveSheet.Paste
           
            Sheets("Kundedata").Activate
            Application.CutCopyMode = False
            Exit Sub
        End If
    Next ræk
End Sub