08. maj 2004 - 17:01Der er
6 kommentarer og 1 løsning
Samle udvalgte data fra flere ark i ét
Jeg har en excel fil pr. projekt og de er alle ens med undtagelse af diverse beløb. Jeg vil gene samle udvalgte data sammen i en anden excelfil, for at skabe et løbende økonomisk overblik. Det skal helst være nemt at få et nyt projekt tilføjet i opsamlingsfilen så almindelige brugere selv kan gøre det.
Hvordan gør jeg det nemmest?
Alle filer kan placeres i samme mappe hvis det er nødvendigt.
De fleste virksomheder har efterhånden bevist, at AI virker.
Pilotprojekter leverer resultater. Medarbejdere bruger generative AI-værktøjer. Nye use cases dukker op på tværs af organisationen.
Sub HentArk() Dim AD As Variant, A As Integer, FRes(8) As Variant, FS As Range Dim strFilNavn(), Nr As Integer Application.CutCopyMode = False Application.ScreenUpdating = False mypath = "C:\MitExcelBibliotek\" ' ret til din sti If Right(mypath, 1) <> "\" Then mypath = mypath & "\" Nr = 1 ReDim Preserve strFilNavn(Nr) strFilNavn(Nr) = Dir(mypath & "*.xls") ' Hent den første filnavn i biblioteket. Do While strFilNavn(Nr) <> "" ' Start løkken If strFilNavn(Nr) <> "." And strFilNavn(Nr) <> ".." Then Nr = Nr + 1 ReDim Preserve strFilNavn(Nr) End If strFilNavn(Nr) = Dir ' Hent næste filnavn. Loop '************** alle filer er læst ind i variablen strFilNavn(Nr) **********
For I = 1 To Nr - 1 AD = ThisWorkbook.Sheets("Ark2").Range("A65536").End(xlUp).Row + 1 ' ovenstående er siden og rækken der skal indsættes på FilogSti = mypath & strFilNavn(I)
AF = ThisWorkbook.Sheets("Ark1").Range("A65536").End(xlUp).Row + 1 For U = 2 To AF - 1 ' tjekker om de er inlæst før If strFilNavn(I) = ThisWorkbook.Sheets("Ark1").Range("A" & U) Then MsgBox ActiveWorkbook.Name & " er indlæst 1 gang" GoTo Videre End If Next
' Åbner filen Workbooks.OpenText Filename:=FilogSti ThisWorkbook.Sheets("Ark1").Cells(AF, 1) = strFilNavn(I) ' sætter filnavnet ind på ark1 i ThisWorkbook
Sheets("Ark1").Select ' det ark der skal hentes data fra på det åbnede ark Range("A1:I32").Copy ' det områder der skal hentes data fra
ThisWorkbook.Activate Sheets("Ark2").Activate Range("A" & AD).Select ' Arket og cellen det sættes ind på ActiveSheet.Paste
'lukker filen Windows(strFilNavn(I)).Activate Application.DisplayAlerts = False ActiveWorkbook.Saved = True ActiveWindow.Close Application.DisplayAlerts = True Application.CutCopyMode = False Videre: Next 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.