Kopier variable celler over i et andet ark ved hjælp af vba

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1
On Error Resume Next
BaseLrow = Range("A65536").End(xlUp).Row
Base = Range("A2:N" & BaseLrow)

With Worksheets("Ark3")
    .Range("A2").Select
    .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).ClearContents
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Daghold" 'A
        LR = .Range("A65536").End(xlUp).Row + 1
        .Cells(LR, 1) = D
        .Cells(LR, 2) = Base(I, 1)
        .Cells(LR, 3) = Base(I, 2)
        .Cells(LR, 4) = Base(I, 3)
        .Cells(LR, 5) = Base(I, 14)
        D = D + 1
        Case "Aftenhold" 'F
        LR = .Range("F65536").End(xlUp).Row + 1
        .Cells(LR, 6) = A
        .Cells(LR, 7) = Base(I, 1)
        .Cells(LR, 8) = Base(I, 2)
        .Cells(LR, 9) = Base(I, 3)
        .Cells(LR, 10) = Base(I, 14)
        A = A + 1
        Case "Nathold" ' K
        LR = .Range("K65536").End(xlUp).Row + 1
        .Cells(LR, 11) = N
        .Cells(LR, 12) = Base(I, 1)
        .Cells(LR, 13) = Base(I, 2)
        .Cells(LR, 14) = Base(I, 3)
        .Cells(LR, 15) = Base(I, 14)
       
        N = N + 1
        Case Else
       
        MsgBox Base(I, 13) & " ikke fundet"
        End Select
    Next
End With
End Sub


du skal køre makroen mens du står i dataarket med din medarbejderdatabase.

Lav selv overskrifter i Ark3

der var lige en fejl:

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1
BaseLrow = Range("A65536").End(xlUp).Row
Base = Range("A2:N" & BaseLrow)

With Worksheets("Ark3")
    R = .Range("A1").CurrentRegion.Rows.Count
        .Rows("2:" & R).Delete
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Daghold" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aftenhold" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nathold" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
        Case Else
            MsgBox Base(I, 13) & " ikke fundet"
        End Select
    Next
End With
End Sub

Hej Kabbak

Jeg må snart få lært lidt om det her VBa
Kan du ikke lige smide en lille vejledning.

Hvilke ark skal jeg kopier ovenstående ind i ??????????
Skal det i Woorksheet eller hvor

Hilsen Jan

I et Modul
Når du er i VBA editoren så
Insert > Module

smid koden derind

Tak Jeg prøver lige

Når du står i dit database ark, så prøv at højreklikke et tomt sted på menulinien, vælg Formularer.

Tryk på den der ligner en knap, tegn med musen på arket, hvor du vil have den, nu spørger den om hvilken makro den skal aktivere ved tryk, der vælger du denne her, nu kan du køre makroen ved at trykke der, i stedet for makroer kør.

Jeg glemte at sige følgende

1, Min Valideringsliste inderholder 12 elementer hvor af jeg kun vil bruge de omtalte : Daghold , aftenhold og Nathold (måske også ferie)
2. Data i Ark 1 starter i række 3 . Række 2 er overskriftsfelter Celle M2 har jeg kaldet "Hold" som overskrift.

Overskrifterne har ingen betydning, da de ikke læses.

Jeg har nu lavet så den starter i række 3 og fjernet Msgboxen, så du ikke skal svare.

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1
BaseLrow = Range("A65536").End(xlUp).Row
Base = Range("A3:N" & BaseLrow)

With Worksheets("Ark3")
    R = .Range("A1").CurrentRegion.Rows.Count
        .Rows("2:" & R).Delete
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Daghold" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aftenhold" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nathold" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
        Case Else
         
        End Select
    Next
End With
End Sub

Skal jeg "Ryd indhold" i ark3 inden jeg kører en ny opdatering.

KAn det laves pr automatik . Det må bare ikke rydde 1-4

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1
BaseLrow = Range("A65536").End(xlUp).Row
Base = Range("A5:N" & BaseLrow)

With Worksheets("Ark3")
    R = .Range("A1").CurrentRegion.Rows.Count
        .Rows("2:" & R).Delete
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Daghold" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aftenhold" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nathold" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
        Case Else
         
        End Select
    Next
End With
End Sub

det gør den selv, er rettet her til at slette fra række 5

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1
BaseLrow = Range("A65536").End(xlUp).Row
Base = Range("A3:N" & BaseLrow)

With Worksheets("Ark3")
    R = .Range("A1").CurrentRegion.Rows.Count
        .Rows("5:" & R).Delete
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Daghold" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aftenhold" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nathold" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
        Case Else
         
        End Select
    Next
End With
End Sub


den var ikke rettet aligevel

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer, F As Integer
D = 1
A = 1
N = 1
F = 1
BaseLrow = Range("A65536").End(xlUp).Row
Base = Range("A3:N" & BaseLrow)

With Worksheets("Ark3")
    R = .Range("A1").CurrentRegion.Rows.Count
        .Rows("5:" & R).Delete
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Daghold" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aftenhold" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nathold" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
        Case "Ferie" ' P
            LR = .Range("P65536").End(xlUp).Row + 1
            .Cells(LR, 16) = F
            .Cells(LR, 17) = Base(I, 2)
            .Cells(LR, 18) = Base(I, 3)
            .Cells(LR, 19) = Base(I, 4)
            .Cells(LR, 20) = Base(I, 14)
            F = F + 1

           
        Case Else
         
        End Select
    Next
End With
End Sub

Hvad laver jeg forkert her Har indsat "Ferie" i kolonne P

Det ser rigtig ud, hvis det ikke virker, kan det være fordi Ferie ikke er stavet ens på arket og her i koden, vær opmærksom på store og små bogstaver.

Fandt fejlen: I valideringslisten hedder det : Aften, Nat,Dag.

Men den indsætter i data Ark3 fra række 2, den skal starte i række 5

With Worksheets("Ark3")
    R = .Range("A1").CurrentRegion.Rows.Count
        .Rows("5:" & R).Delete

Er det ikke her jeg skal rette et eller andet???

Kan jeg få den begrænset indefor række 5 - række 50?????

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer, F As Integer
D = 1
A = 1
N = 1
F = 1
BaseLrow = Range("A65536").End(xlUp).Row
Base = Range("A3:N" & BaseLrow)

With Worksheets("Ark3")
          .Rows("5:50" ).Delete Shift:=xlUp
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Daghold" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            If LR < 5 Then LR = 5
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aftenhold" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            If LR < 5 Then LR = 5
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nathold" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            If LR < 5 Then LR = 5
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
        Case "Ferie" ' P
            LR = .Range("P65536").End(xlUp).Row + 1
            If LR < 5 Then LR = 5
            .Cells(LR, 16) = F
            .Cells(LR, 17) = Base(I, 2)
            .Cells(LR, 18) = Base(I, 3)
            .Cells(LR, 19) = Base(I, 4)
            .Cells(LR, 20) = Base(I, 14)
            F = F + 1

           
        Case Else
         
        End Select
    Next
End With
End Sub

Hvis den skal lave det samme i Ark2 (Funktionær)
Kan jeg så lave en fælles opdatering enten i Ark 1 eller Ark 3.
Eller hvad med en automatik når jeg går om og ser på Ark 3, så opdatere den både fra Ark1(Timelønnet) og Ark 2(funktionær)????

Mener du at Ark2 er ligesom Ark1, altså en database ?

Skal de så også over i Ark3, sammen med de andre ?

Den indsætter stadig fra række 2 og nedefter??????????

Kan der også laves Autotilpas på kolonner ved opdatering

Håber ikke du er træt af mine dumme spørgsmål. Jeg er lidt vanskelig....:-)

Nemlig Ja !

Kan Jeg bruge denne her

With xlsheet
    .Columns.AutoFit
  End With

Next
    .Cells.EntireColumn.AutoFit' auto justerer celler
End With


har du denne række sat ind alle steder

  If LR < 5 Then LR = 5

Ups , den havde jeg ikke lige set

Stadigvæk række 2

BaseLrow = Range("A65536").End(xlUp).Row
Base = Range("A3:N" & BaseLrow)

With Worksheets("Ark3")
          .Rows("5:50").Delete Shift:=xlUp

     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Dag" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            If LR < 5 Then LR = 5
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aften" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            If LR < 5 Then LR = 5
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nat" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            If LR < 5 Then LR = 5
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
                   
        Case Else
         
        End Select
    Next
            .Cells.EntireColumn.AutoFit ' auto justerer celler
End With
End Sub

den ryger ind fra række 5, hvergang ved mig

Nu virker det.
Jeg oprettede et nyt ark og døbte det "Bemandingsplan".

Kan jeg beholde formateringen i det ark ("Bemandingsplanen") hvor modulet indsætter ny data. Det er skrifttyper og rammer jeg gerne vil beholde fra ganga til gang

erstat

.Rows("5:50").Delete Shift:=xlUp
med

  .Rows("5:50").ClearContents

Kan du klarer den med Ark1 og Ark3.
Eller får jeg ikke mere for pengene... :-))))

Hvor kan jeg lære om VBA?????? Har du nogle gode websteder eller forslag til bøger

hvis arkene ar ens opbygget, er det bare at kopiere hele koden og henvise til det andet ark.

smid lige den kode ind du er kommet frem til , så skal jeg tilpasse den.

Funktionærene skal vel også over i ark3

Hvis du så lige skriver de rigtige arknavne, på de 3 ark, så er det helt i orden.

Ark1 = Hedder "Dipak"

Her henter jeg
Kolonne 2,3,4,14 fra række 3 og nedefter.
Datene lægges i Ark "Bemandingsplan"
Datene kopieres i Ark "Bemandingsplan"
De skal ind i række 13-50 (Række 12 må ikke slettes)






Ark2 = Hedder "Funktionær"

Her henter jeg
Kolonne 2,3,4,11 og 12 fra række 3 og nedefter.
Datene kopieres i Ark "Bemandingsplan"
De skal ind i række 5-11 (Række 12 må ikke slettes)

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1

BaseLrow = Range("A65536").End(xlUp).Row
Base = Range("A3:N" & BaseLrow)

With Worksheets("Bemandingsplan")
          .Rows("13:50").ClearContents
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Dag" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            If LR < 13 Then LR = 13
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aften" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            If LR < 13 Then LR = 13
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nat" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            If LR < 13 Then LR = 13
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
                   
        Case Else
         
        End Select
    Next
            .Cells.EntireColumn.AutoFit ' auto justerer celler
End With
End Sub

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1

BaseLrow = Worksheets("Dipak").Range("A65536").End(xlUp).Row
Base = Worksheets("Dipak").Range("A3:N" & BaseLrow)

With Worksheets("Bemandingsplan")
          .Rows("5:11").ClearContents
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Dag" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            If LR < 5 Then LR = 5
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aften" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            If LR < 13 Then LR = 13
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nat" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            If LR < 13 Then LR = 13
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
                   
        Case Else
         
        End Select
    Next
         
End With

D = 1
A = 1
N = 1
BaseLrow = Worksheets("Funktionær").Range("A65536").End(xlUp).Row
Base = Worksheets("Funktionær").Range("A3:N" & BaseLrow)

With Worksheets("Bemandingsplan")
          .Rows("13:50").ClearContents
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13) ' kolonne 13,= den kolonne hvor Dag,Aften og Nat står
        Case "Dag" 'A
            LR = D + 4
           
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 11)
            .Cells(LR, 6) = Base(I, 12)
            D = D + 1
        Case "Aften" 'F
            LR = A + 4
            .Cells(LR, 7) = A
            .Cells(LR, 8) = Base(I, 2)
            .Cells(LR, 9) = Base(I, 3)
            .Cells(LR, 10) = Base(I, 4)
            .Cells(LR, 11) = Base(I, 11)
            .Cells(LR, 12) = Base(I, 12)
            A = A + 1
        Case "Nat" ' K
            LR = N + 4
            .Cells(LR, 13) = N
            .Cells(LR, 14) = Base(I, 2)
            .Cells(LR, 15) = Base(I, 3)
            .Cells(LR, 16) = Base(I, 4)
            .Cells(LR, 17) = Base(I, 11)
            .Cells(LR, 18) = Base(I, 12)
            N = N + 1
                   
        Case Else
         
        End Select
    Next
            .Cells.EntireColumn.AutoFit ' auto justerer celler
End With
End Sub

Skal jeg køre makro på ARk "Dipak" hvergang????

ikke nødvendigvis, den kan deles i 2 makroer

Sub OpdaterMedarbejder()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1

BaseLrow = Worksheets("Dipak").Range("A65536").End(xlUp).Row
Base = Worksheets("Dipak").Range("A3:N" & BaseLrow)

With Worksheets("Bemandingsplan")
          .Rows("5:11").ClearContents
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13)
        Case "Dag" 'A
            LR = .Range("A65536").End(xlUp).Row + 1
            If LR < 5 Then LR = 5
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 14)
            D = D + 1
        Case "Aften" 'F
            LR = .Range("F65536").End(xlUp).Row + 1
            If LR < 13 Then LR = 13
            .Cells(LR, 6) = A
            .Cells(LR, 7) = Base(I, 2)
            .Cells(LR, 8) = Base(I, 3)
            .Cells(LR, 9) = Base(I, 4)
            .Cells(LR, 10) = Base(I, 14)
            A = A + 1
        Case "Nat" ' K
            LR = .Range("K65536").End(xlUp).Row + 1
            If LR < 13 Then LR = 13
            .Cells(LR, 11) = N
            .Cells(LR, 12) = Base(I, 2)
            .Cells(LR, 13) = Base(I, 3)
            .Cells(LR, 14) = Base(I, 4)
            .Cells(LR, 15) = Base(I, 14)
            N = N + 1
                   
        Case Else
         
        End Select
    Next
    .Cells.EntireColumn.AutoFit ' auto justerer celler
End With
End Sub


Sub OpdaterFunktionærer()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1
BaseLrow = Worksheets("Funktionær").Range("A65536").End(xlUp).Row
Base = Worksheets("Funktionær").Range("A3:N" & BaseLrow)

With Worksheets("Bemandingsplan")
          .Rows("13:50").ClearContents
     
    For I = 1 To UBound(Base)
        Select Case Base(I, 13) ' kolonne 13,= den kolonne hvor Dag,Aften og Nat står
        Case "Dag" 'A
            LR = D + 4
           
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 11)
            .Cells(LR, 6) = Base(I, 12)
            D = D + 1
        Case "Aften" 'F
            LR = A + 4
            .Cells(LR, 7) = A
            .Cells(LR, 8) = Base(I, 2)
            .Cells(LR, 9) = Base(I, 3)
            .Cells(LR, 10) = Base(I, 4)
            .Cells(LR, 11) = Base(I, 11)
            .Cells(LR, 12) = Base(I, 12)
            A = A + 1
        Case "Nat" ' K
            LR = N + 4
            .Cells(LR, 13) = N
            .Cells(LR, 14) = Base(I, 2)
            .Cells(LR, 15) = Base(I, 3)
            .Cells(LR, 16) = Base(I, 4)
            .Cells(LR, 17) = Base(I, 11)
            .Cells(LR, 18) = Base(I, 12)
            N = N + 1
                   
        Case Else
         
        End Select
    Next
            .Cells.EntireColumn.AutoFit ' auto justerer celler
End With
End Sub

Tusinde tak for hjælpen.

Det virker perfekt efter lidt tilrettelser

Med venlig hilsen

Pejsen

selv tak

Jeg har lige fundet ud af jeg har lavet det lidt forkert.

I Funktionærarket har jeg i kolonne 11 funktionærens "Titel"
og kolonne 12 hvilket skift de er på:

Det jeg ønskede var at det kun var nogle bestemte titler jeg vil have med i opdateringen nemlig "Maskinfører" på "Dag", "Aften" eller "Nat"
Jeg får vist alle funktionær, på alle 3 skift og det var ikke meningen

Kan man lave en eller anden IF-sætning

LR = .Range("k:k")
            If LR = "Dag" Then = "Maskinfører"

Hvad ved jeg???????????

Sub OpdaterFunktionærer()
Dim Base As Variant, BaseLrow As Integer, LR As Integer, I As Integer
Dim D As Integer, A As Integer, N As Integer
D = 1
A = 1
N = 1
BaseLrow = Worksheets("Funktionær").Range("A65536").End(xlUp).Row
Base = Worksheets("Funktionær").Range("A3:N" & BaseLrow)

With Worksheets("Bemandingsplan")
          .Rows("13:50").ClearContents
     
    For I = 1 To UBound(Base)
    If Base(i,11) = "Maskinfører" then
        Select Case Base(I, 12) ' kolonne 12,= den kolonne hvor Dag,Aften og Nat står
        Case "Dag" 'A
   
            LR = D + 4
           
            .Cells(LR, 1) = D
            .Cells(LR, 2) = Base(I, 2)
            .Cells(LR, 3) = Base(I, 3)
            .Cells(LR, 4) = Base(I, 4)
            .Cells(LR, 5) = Base(I, 11)
            .Cells(LR, 6) = Base(I, 12)
            D = D + 1
        Case "Aften" 'F
            LR = A + 4
            .Cells(LR, 7) = A
            .Cells(LR, 8) = Base(I, 2)
            .Cells(LR, 9) = Base(I, 3)
            .Cells(LR, 10) = Base(I, 4)
            .Cells(LR, 11) = Base(I, 11)
            .Cells(LR, 12) = Base(I, 12)
            A = A + 1
        Case "Nat" ' K
            LR = N + 4
            .Cells(LR, 13) = N
            .Cells(LR, 14) = Base(I, 2)
            .Cells(LR, 15) = Base(I, 3)
            .Cells(LR, 16) = Base(I, 4)
            .Cells(LR, 17) = Base(I, 11)
            .Cells(LR, 18) = Base(I, 12)
            N = N + 1
                   
        Case Else
         
        End Select
      end if
    Next
            .Cells.EntireColumn.AutoFit ' auto justerer celler
End With
End Sub

Kanont

Kan man bruge flere if'er ?????????
Eks. Både "MAskinfører" og "Værkfører" og "Projektleder"

Jeg vil squ gerne lære det her VBA . Det er smart!

If Base(i,11) = "Maskinfører" or Base(i,11) = "Værkfører" or Base(i,11) = "Projektleder" then

alle 3 kommer med

Tusinde tak!

Jeg har vist fået mere end rigeligt for mine "Penge"!!
Jeg opretter lige nogel flere spørgsmål, da jeg har en del mere som skal laves i VBA.

Hvem tror du, der ved noget om Brevfletning???

Venlig hilsen Jan