how to select a specific cells range dynamically in excel vba? - excel

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