Hente data fra flere forskellige regneark til et samleark

Åben en ny tom mappe.

Indsæt et modul i VBA og sæt denne kode derind.

Public Sub SamleData()
  Dim Fil As Variant, WS As Worksheet, Navn As String, Rk As Long, Overskrift As Boolean
  Dim SkrivOverskrift As Variant, Kol As Long
  Overskrift = False
ChDir ThisWorkbook.Path
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        ReDim Fil(.SelectedItems.Count)
        For I = 1 To .SelectedItems.Count
        Fil(I) = .SelectedItems(I)
        Next
    End With
svar = MsgBox(" er der overskrifter i række 1 ", vbYesNo)
If svar = vbYes Then
Overskrift = True
End If

    For I = 1 To UBound(Fil)
  Workbooks.Open (Fil(I))
For Each WS In ActiveWorkbook.Sheets
Navn = WS.Name
WS.Activate
    If Overskrift Then
    Kol = ActiveSheet.UsedRange.Columns.Count
        SkrivOverskrift = Range(Cells(1, "A"), Cells(1, Kol))
        Data = Range(Range("A2"), Range("A2").SpecialCells(xlLastCell))
    Else
        Data = Range(Range("A1"), Range("A2").SpecialCells(xlLastCell))
    End If
 
Call SheetsExist(Navn) ' er siden oprettet, ellers bliver den det
With ThisWorkbook
Rk = .Worksheets(WS.Name).UsedRange.Rows.Count
    If .Worksheets(WS.Name).Range("A1") = "" Then
        .Worksheets(WS.Name).Cells(1, 1).Resize(UBound(SkrivOverskrift, 1), UBound(SkrivOverskrift, 2)) = SkrivOverskrift
    End If
.Worksheets(WS.Name).Cells(Rk + 1, 1).Resize(UBound(Data, 1), UBound(Data, 2)) = Data
End With
Next
For Each Wb In Workbooks
If Wb.Name <> ThisWorkbook.Name Then
Wb.Close SaveChanges:=False
End If
Next
    Next

   
End Sub

Public Sub SheetsExist(Navn)
Dim WS As Worksheet
With ThisWorkbook
For Each WS In .Sheets
If WS.Name = Navn Then
.Worksheets(WS.Name).Activate
Exit Sub
End If
Next
.Worksheets.Add    ' opretter nyt ark
  .ActiveSheet.Name = Navn  ' Navngiver arket
  End With
End Sub

Har du prøvet Excel´s
Konsolidering ?

Jeg kan ikke finde ud af, hvad denne kode gør. Egentlig skal jeg blot have løst mit problem med at Application.FileSearch ikke virker i 2013. Løser koden det problem?

FileSearch forsvandt med Excel 2007. Du skal bruge FileSystemObject.
Se: http://msdn.microsoft.com/en-us/library/office/jj229903.aspx
og: http://msdn.microsoft.com/en-us/library/office/gg278516.aspx for eksempel.

Tak. Så langt så godt. Ergo skal jeg have lavet min kode om, så den kan finde filerne. Problemet er, at jeg ikke er en haj til VBA kode, så jeg ved ikke, hvordan jeg bruger den nye kommando. Er der en af jer hajer, så nemt kan skrive de linier jeg skal bruge i stedet for den gamle funktion?

Det er jo en kende vanskeligt, når man ikke kender din gamle funktion, men der findes søgemaskiner, som kan lede en på sporet af, hvordan man gør - fx hertil:
http://www.xl-central.com/list-files-fso.html