Как выбрать определенный диапазон ячеек динамически в Excel VBA?

Question

У меня есть сценарий, в котором я копирую данные из нескольких файлов в мастер-файлы. Я хочу, чтобы при первом запуске программы она начинала вставлять данные в указанном мной диапазоне в мастер-файл, который работает нормально.Но когда программа запускается снова, она не собирается запускаться с предыдущего диапазона, скорее, она начинает вставлять данные ниже в предыдущую запись, которая является дублированием тех же данных, я хочу, чтобы, когда пользователь впервые или столько же раз запустил диапазон программыначать в том же месте, где он был в первый раз работает.Ниже приведен мой код.

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

Проблема: я хочу, чтобы, когда программа запускалась столько раз, она начала вставлять Данные в Диапазон, в который она вставляет данные в первый раз.Следующие изображения прояснят мою проблему более точно.Когда программа запускается в первый раз, я получаю вставленные данные ниже диапазона, который я хочу.

При запуске во второй раз я получаюданные ниже диапазона что я должен сделать, чтобы поведение было таким, чтобы при запуске программы столько раз, сколько данных должно быть вставлено в диапазон, в котором она выполняется в первый раз, см. рис.

Answer 1

Вот два разных способа сделать это:

---

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