VBA kode til at kopire værdier i mange excel filer til en samle excelfil.

JEg har denne kode fra en anden opgave som minder om dette problem
Sub IndsamlHjemlaan()
Dim fdBrowser As FileDialog, Mappenavn As String, Filnavn As String
Dim wb As Workbook, ws As Worksheet, samlws As Worksheet, _
lnr As Integer, rg As Range, rknr As Integer

Set fdBrowser = Application.FileDialog(msoFileDialogFolderPicker)

With fdBrowser
.Title = "Valg mappe hvorfra workbooks skal lases"
.Show
Mappenavn = .SelectedItems(1)
End With

Set samlws = Worksheets.Add
samlws.Name = "Indsaml hjemlån"
lnr = 1

Filnavn = Dir(Mappenavn & "\StudentID*.xls*", vbNormal)

Do While Len(Filnavn) > 0
Set wb = Workbooks.Open(Filename:=Filnavn, ReadOnly:=True)
Set ws = Worksheets("Hjemlån")
Set rg = ws.UsedRange

If lnr = 1 Then
  rg.Cells(1, 1).Copy
  samlws.Cells(1, 1).PasteSpecial
  rg.Cells(2, 1).Copy
  samlws.Cells(1, 2).PasteSpecial
  Range("A6", "G6").Copy
  samlws.Cells(1, 3).PasteSpecial
  lnr = lnr + 1
End If
For rknr = 7 To rg.Rows.Count
  rg.Cells(1, 2).Copy
  samlws.Cells(lnr, 1).PasteSpecial
  rg.Cells(2, 2).Copy
  samlws.Cells(lnr, 2).PasteSpecial
  rg.Rows(rknr).Copy
  samlws.Cells(lnr, 3).PasteSpecial
  lnr = lnr + 1
Next
Set rg = Nothing
Set ws = Nothing
wb.Close SaveChanges:=False
Filnavn = Dir
Columns("A:I").EntireColumn.AutoFit
Loop

End Sub