Kopiere kolonne fra kopieret ark og indsætte kolonnen i et andet?

*indsætter sit navn*

Ja - det er forståeligt. Hvis du har filerne og sender dem til: pb@supertekst-it - så skal jeg prøve at skrive VBA-koden.

Model er udarbejdet - hvis du senderen mail - returneres denne...

Ok tak. Jeg prøver at sende dem tirsdag.

Foreløbig forslag:

Dim ark
Private Sub CommandButton1_Click()
    If Cells(1, 2) <> "" Then
        navn = Cells(1, 2)
        antalark = ActiveWorkbook.Sheets.Count
        Cells(1, 2) = ""
       
Rem kontroller at ark ikke findes i forvejen
        If findesArk(navn) = False Then
       
Rem Opret nyt ark med medarbejder-navn
            ActiveWorkbook.Sheets.Add After:=Sheets(antalark)
            Sheets(antalark + 1).Name = navn
       
Rem kopier LønMaster til nyt ark
            Set ark = ActiveWorkbook.Sheets("LønMaster")
            ark.Select
            ark.Range("A1:D24").Select
            Selection.Copy
           
            ActiveWorkbook.Sheets(antalark + 1).Activate
            ActiveSheet.Cells(1, 1).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            ActiveSheet.Range("A2").Select
           
Rem kopier ny medarbejder til Samlet
            overførTilSamlet antalark + 1, navn
        Else
            MsgBox ("Arket " + navn + " findes i forvejen!")
        End If
    End If
End Sub
Private Function findesArk(navn)
    For Each sh In ActiveWorkbook.Sheets
        If navn = sh.Name Then
            findesArk = True
            Exit Function
        End If
    Next sh
    findesArk = False
End Function
Private Sub overførTilSamlet(nytArkNr, navn)
Dim fArk, tArk
    Set fArk = ActiveWorkbook.Sheets(nytArkNr)
    fArk.Select
    fArk.Range("D2:D24").Select
    Selection.Copy

    Set tilark = ActiveWorkbook.Sheets("Samlet")
    tilark.Select

Rem beregn næste kolonne
    nykol = ActiveCell.SpecialCells(xlLastCell).Column

Rem indsætnavn
    tilark.Cells(1, nykol + 1) = navn
   
Rem indsæt total-kolonne
    tilark.Cells(2, nykol + 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    tilark.Cells(2, nykol + 1).Select
End Sub