Hej!

Detta är lite komplicerat och inte gjort i en handvänding. Låt oss ta det lite stegvis.

*** 1. Hämta filnamnen och deras sökväg ***

Börja med att göra en referens till Microsoft.Scripting.Tuntime (vilket vi gör i VBA-editorn, menyval verktyg/tools och alternativet referenser/references)

Skriv därefter koden nedan men korrigera sökvägen som nedan är c:\temp\done till den sökväg du vill använda. Testkör koden. Den kommer att i direktfönstret skriva ut namnen på filerna du vill öppna.

Public Sub FindXlsx()
    Dim objFso As Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder
    Dim vFilePath As Variant

    Set objFso = New Scripting.FileSystemObject
    Set objFolder = objFso.GetFolder("c:\temp\done")
   
    For Each vFilePath In objFolder.Files
        If Right(vFilePath, 5 = ".xlsx" Then
            Debug.Print vFilePath
        End If
    Next
End Sub

*** 2. Öppna fil ***

Nästa pusselbit är att öppna en fil, välja ett ark i denna fil och flytta över data från det arket till det ark där vi vill att data skall hamna.

Metoden nedan

Public Sub OpenExcelFile()
    Dim wbImport As Workbook
    Dim wsImport As Worksheet
    Dim wsTarget As Worksheet
   
    Dim sFilePath As String
    Dim rngImport As Range
    Dim vData As Variant

    sFilePath = "C:\Temp\Done\CRE05_2011-11-06.xls"
   
    Set wbImport = Workbooks.Open(sFilePath)
    ' Här väljs ark 2, men det går även att ange namnet på arket, t.ex. wbImport.Worksheets("Blad 3")
    Set wsImport = wbImport.Worksheets(2)
    Set rngImport = wsImport.Range("A1", "B10") ' Dessa celler vill jag ha tag i.
    
    ' Här väljer vi arket vi vill att data skall hamna i
    Set wsTarget = ThisWorkbook.Sheets(1)
   
    ' Hämta data från källarket till en matris: vData
    vData = rngImport.Value
   
    ' Vi skall lägga värden i cellen A1 och fylla till höger och nedom denna cell.
    ' Därför gör vi en resize med hjälp av antalet rader respektive antalet kolumner i vData
    ' Till sist fyller vi detta resizade område med data från vData
    wsTarget.Range("A1").Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
   
    ' Glöm inte stänga. Argumnetet false innebär att vi inte sparar innan vi stänger
    Call wbImport.Close(False)
End Sub

*** 3. Kombinera finna filnamn och öppna filer ***
Sista steget får du knåpa ihop själv. Du har ovan en metod som tar fram sökvägen till filerna och en metod som öppnar filen med en viss sökväg. Ändra på den sista metoden så att den tar emot sökvägen som argument. Ändra vidare på koden så att den letar upp första tomma raden i målarket och börjar fylla på med data där. Då kommer det att fungera.

Lycka till!

/Kihlman