Sammenlægning af ugesedler

Skal de ansatte stå under hinanden ? Du skal nok ud i VBA - Mvh finb

VBA er fint nok.

Jeg vil gerne ende med en liste i ét regneark, hvor alle udførte opgaver står under hinanden. Hver linje indeholder også medarbejderens initialer, så ja, jeg vil gerne have dem til at stå under hinanden.

/Mikael

Har disse excel ugefiler et navn, eller en del af navnet, man kan kende dem på.

Som udgangspunkt er de navngivet

Ugeseddel-ÅR-UGENR-INITIALER

Sæt denne i en tom excel mappe, koden henter data fra de excel mapper du vælger.

Jeg går ud fra at der er overskrifter i mapperne, så det er kun den første jeg læser række 1 ind fra.

ret selv 6 tallet, den der styrer antal kolonner.

Option Explicit

Public Sub HentFiler()
    Dim Fil As String, Data As Variant, RW As Long, I As Integer
   
      RW = 1    ' startrække
      Application.ScreenUpdating = False
      Cells.ClearContents ' tømmer arket, inden ny indlæses
    With Application.FileDialog(msoFileDialogOpen)
        .Show
        .AllowMultiSelect = True
        If .SelectedItems.Count = 0 Then Exit Sub
        For I = 1 To .SelectedItems.Count
            Fil = .SelectedItems(I)
            RW = Cells(65500, "A").End(xlUp).Row
      Workbooks.Open Filename:=Fil
          If RW = 1 Then
          Data = Range(Cells(1, 1), Cells((Cells(65500, "A").End(xlUp).Row), 6)) ' kolonne a = A til & = F,( med overskrifter i række 1)
          Else
          Data = Range(Cells(2, 1), Cells((Cells(65500, "A").End(xlUp).Row), 6)) ' kolonne a = A til & = F ( UDEN  række 1)
          End If
              ActiveWorkbook.Close False
            Range("A" & RW).Resize(UBound(Data, 1), UBound(Data, 2)) = Data
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Alt i alt perfekt.
Hvordan nu hvis overskrifterne er i række 4?
Point er på vej :o)

Æææh point er på vej var måske lidt hurtigt, hvordan giver jeg dig dem? Det er vist et par år siden jeg sidst har været her inde :o)

Hvis overskrifter er i række 4, så

      If RW = 1 Then
          Data = Range(Cells(4, 1), Cells((Cells(65500, "A").End(xlUp).Row), 6)) ' kolonne a = A til & = F,( med overskrifter i række 1)
          Else
          Data = Range(Cells(5, 1), Cells((Cells(65500, "A").End(xlUp).Row), 6)) ' kolonne a = A til & = F

Den får ikke sidste række med i den første af filerne?

tak for point ;-))