如何在excel vba中动态选择特定的单元格范围？

Question

I've a scenario in which i'm copying data from multiple files to master files, I want when the program run at first time it should start pasting the data at my specified range in the master file which is working fine. But when the program is run again it's not going to start from the previous range rather it's start pasting data below at the previous record which is duplication of the same data, I want that when user first time or as many time run the program program range start at the same location where it was at first time running. Following is my code.

Sub Append()
 'Append data from other files
  Path = "E:\NPM PahseIII\"
 Dim c As Range

   'find the second empty cell in ColA
 Set c = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
   'target range for pasting data it first run this is actually pointing to 
   'my desire range but at second or multiple running the range is starting 
    'below at the previous record 
 Set targetcellL = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 1)
 Set targetcellR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(5, 4)
 Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
If InStr(Filename, ".") > 0 Then
 Filenamenoext = Left(Filename, InStr(Filename, ".") - 1)
End If
   c.Value = Filenamenoext
   Set c = c.Offset(4, 0)

  Set wb = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
Data = wb.Worksheets(1).Range("B3:E6").Value
wb.Worksheets(1).Range("B3:E6").Copy
ThisWorkbook.Activate
ActiveSheet.Range(targetcellL, targetcellR).Select
  ActiveSheet.Paste
  Set targetcellL = targetcellL.Offset(4, 0)
  Set targetcellR = targetcellR.Offset(5, 0)
Workbooks(Filename).Close
Filename = Dir()
Loop

End Sub

Problem: I want that when the program as run as many time it should start pasting Data it the Range where it is pasting data for the first time. Following images will clear my problem more precisely. When the program run for the first time i get pasted data it below range which is what i want.

When Run for the 2nd time i get data it below range what should i do to make the behavior as such that when the program run for as many time the data should paste at the range where it's at first run see pic.

Answer 1

Here are two different ways to do it:

---

Sub AppendValuesAndFormats()
'Append data from other files
    Const Path = "E:\NPM PahseIII\"
    Dim target As Range

    With ThisWorkbook.ActiveSheet
        .UsedRange.Offset(2).ClearContents
        Set target = .Range("A3")
    End With

    Filename = Dir(Path & "*.xlsx")

    Do While Filename <> ""
        With Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
            target.Value = IIf(InStr(Filename, ".") > 0, Left(Filename, InStr(Filename, ".") - 1), "")
            .Worksheets(1).Range("B3:E6").Copy Destination:=target.Offset(0, 1)
            .Close SaveChanges:=False
        End With
        Set target = target.Offset(4)
        Filename = Dir()
    Loop

End Sub

---

Sub AppendValues()
'Append data from other files
    Const Path = "E:\NPM PahseIII\"
    Dim target As Range

    With ThisWorkbook.ActiveSheet
        .UsedRange.Offset(2).ClearContents
        Set target = .Range("A3")
    End With

    Filename = Dir(Path & "*.xlsx")
    Do While Filename <> ""
        With Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
            target.Value = IIf(InStr(Filename, ".") > 0, Left(Filename, InStr(Filename, ".") - 1), "")
            target.Range("B1:E4").Value = .Worksheets(1).Range("B3:E6").Value
            .Close SaveChanges:=False
        End With
        Set target = target.Offset(4)
        Filename = Dir()
    Loop

End Sub