29. januar 2009 - 19:05
Der er
2 kommentarer og
1 løsning
Genemsøgning af Excelfiler for at kopiere data over i ny Excelfil
Hej
Jeg er novice på Excel området, så be' om hjælp. Og pt. kender jeg iøvrigt ikke alle detaljer i opgaven ;)
Jeg har et stort antal excelfiler (2000+) som har samme struktur. Nogle af dataene skal findes frem og kopieres over i et andet excelark, så jeg ender med at have alle de ønskede data i en enkelt fil, som så bagefter skal behandles videre med et andet værktøj.
Det må kunne laves i VBA koden, men hvordan kalder man kode inde i Excel? (er sikkert meget banalt, sorry)
Jeg kan sagtens lave et loop igennem alle filerne, men hvordan får jeg åbnet den enkelte fil, søgt dataene frem og kopieret over i den nye?
Det er selvfølgelig noget der skulle ha' været færdigt i forgårs.
29. januar 2009 - 23:01
#2
Hvis de ligger samme sted, kan denne bruges
Public Sub HentData()
Dim FolderName As String, I As Integer, NO As Integer, strFilnavn() As Variant
Dim Data() As Variant, DCeller As Variant
Dim RW As Integer, J As Integer
DCeller = Array("C1", "C5", "F8", "D11", "E11", "F11", "D13", "E13", "F13", "J11") ' celler der indeholder de værdier, som vi ønsker hentet
FolderName = "C:\Data" ' rettes til
If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\"
NO = 1
ReDim Preserve strFilnavn(NO)
strFilnavn(NO) = Dir(FolderName & "*.xls") ' Hent den første filnavn.
Do While strFilnavn(NO) <> "" ' Start løkken
If strFilnavn(NO) <> "." And strFilnavn(NO) <> ".." Then
NO = NO + 1
ReDim Preserve strFilnavn(NO)
End If
strFilnavn(NO) = Dir ' Hent næste filnavn.
Loop
NO = NO - 1
ReDim Data(NO, UBound(DCeller))
Application.ScreenUpdating = False
For I = 1 To NO
Workbooks.Open Filename:=FolderName & strFilnavn(I)
For J = 0 To UBound(DCeller)
Data(I, J) = Worksheets("Siden der hentes fra").Range(DCeller(J))
Next
ActiveWorkbook.Close False
Next I
RW = ThisWorkbook.Worksheets("siden der gemmes på").Range("A65536").End(xlUp).Row + 1
ThisWorkbook.Worksheets("siden der gemmes på").Range(Cells(RW, 1), Cells(RW + NO, UBound(DCeller) + 1)) = Data
Application.ScreenUpdating = True
End Sub
