10. juni 2012 - 16:23Der er
3 kommentarer og 1 løsning
Sammenlægning af ugesedler II
Jeg har nogle ugesedeler som folk aflevere hver uge. Hver ugesedel er en excelfil med ét ark, hvor de udfylder en række, for hver opgave de har løst i løbet af ugen.
Jeg vil gerne kunne samle disse ugesedle-lister fra de mange regneark i en fil, som en lang liste med alle folks opgaver. Målet er at kunne sorterer dem efter dato, kunde eller initialer eller lave Pivottabeller over det.
jeg har fået nedenstående kode, som umiddelbart løser det hele, MEN den får ikke sidste række med i de første filer. Kun den sidste fil får alle rækker med :(
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
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
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) ActiveWorkbook.Close False Range("A" & RW).Resize(UBound(Data, 1), UBound(Data, 2)) = Data Else Data = Range(Cells(2, 1), Cells((Cells(65500, "A").End(xlUp).Row), 6)) ' kolonne a = A til & = F ( UDEN række 1) ActiveWorkbook.Close False Range("A" & RW + 1).Resize(UBound(Data, 1), UBound(Data, 2)) = Data End If Next End With Application.ScreenUpdating = True End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.