Jeg anvender en rutine, hvor jeg modtager data i en ens regneark, der er distribuerede til mine kollegaer. Nogle gange modtager jeg regneark, hvor filnavnet er invalidt - fx. indeholdende flere punktummer.
Den makro jeg anvender til at samle data fra de modtagne ark, indeholder en test af filnavnet ...er der nogen der kan hjælpe med at gøre den mere robust?
Hele makroen er vist nedenfor.
Det den gør, er at den går ind i en undermappe der er navngivet "statusrapporter" åbner alle excel-filer og henter linie 75, indsætter den i det regneark makroen er i, på første ledige række.
Sub fileloop() Application.ScreenUpdating = False
Dim MyDir As String Dim strPath As String Dim vaFileName As Variant Dim i As Integer MyDir = ActiveWorkbook.Path ' current path strPath = MyDir & "\Statusrapporter" ' files subdir
With Application.FileSearch .NewSearch .LookIn = strPath .SearchSubFolders = True .Filename = ".xls"
If .Execute > 0 Then
For Each vaFileName In .FoundFiles ' open the workbook Workbooks.Open vaFileName ' kopiere linie With ActiveWorkbook .Worksheets("Rapport_Report").Range("A75:at75").Copy .Close End With
Dim lRow As Long ' Find the FIRST EMPTY row by adding 1 to the last row lRow = ActiveSheet.Cells.Find(What:="*", _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows).Row + 1 'Paste the data into the first 'COMPLETELY empty row ActiveSheet.Paste Destination:=Cells(lRow, 1)
Next End If End With Application.ScreenUpdating = True
End Sub
|