Hjælp til VBA makro

Nedenstående VBA kode stammer fra en fil (MergeWorkbooksCode.xls) fundet på siden Ron's Excel Tips

Der er en makro der åbner en filbrowser så man kan bladre frem til en mappe og vælge en eller flere filer som makroen så kopier et forudbestemt område fra.
Derefter oprettes en ny excel-fil hvor dataområdet fra de valgte filer sættes ind under hinanden.

Jeg ville gerne have at data i stedet bliver sat ind i ark4(DataKopi) startende i celle A5 i den fil makroen køres fra.

Hvordan gør jeg det?

Her er koden:

Option Explicit
Declare Function SetCurrentDirectoryA Lib _
                                      "kernel32" (ByVal lpPathName As String) As Long
                                     

Sub ChDirNet(szPath As String)
    SetCurrentDirectoryA szPath
End Sub


Sub MergeSpecificWorkbooks()
    Dim MyPath As String
    Dim SourceRcount As Long, FNum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    Dim SaveDriveDir As String
    Dim FName  As Variant
   
    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    SaveDriveDir = CurDir
    ChDirNet "G:\"
    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
   
    If IsArray(FName) Then
        'Add a new workbook with one sheet
        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        rnum = 1
        'Loop through all files in the array(myFiles)
        For FNum = LBound(FName) To UBound(FName)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(FName(FNum))
            On Error GoTo 0
           
            If Not mybook Is Nothing Then
                On Error Resume Next
               
                With mybook.Worksheets(1)
                    Set sourceRange = .Range("A5:F76")
                End With
               
                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                   
                Else
                    'if SourceRange use all columns then skip this file
                    If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                        Set sourceRange = Nothing
                    End If
                   
                End If
               
                On Error GoTo 0
                If Not sourceRange Is Nothing Then
                    SourceRcount = sourceRange.Rows.Count
                   
                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                        MsgBox "Sorry there are not enough rows in the sheet"
                        BaseWks.Columns.AutoFit
                        mybook.Close savechanges:=False
                        GoTo ExitTheSub
                       
                    Else
                        'Set the destrange
                        Set destrange = BaseWks.Range("A" & rnum)
                        'we copy the values from the sourceRange to the destrange
                       
                        With sourceRange
                            Set destrange = destrange. _
                                            Resize(.Rows.Count, .Columns.Count)
                        End With
                       
                        destrange.Value = sourceRange.Value
                        rnum = rnum + SourceRcount
                    End If
                   
                End If
               
                mybook.Close savechanges:=False
            End If
           
        Next FNum
        BaseWks.Columns.AutoFit
    End If
   
ExitTheSub:
    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
   
    ChDirNet SaveDriveDir
End Sub