Paste Entire Row in D Column of master

[kshitij_dch]

Hello Team ,

I am working on copying last used row of each workbook in a folder to master workbook.

Code is working fine however it is pasting Data from A column , I want it to paste it from D column , Changes to the code will do however no luck so far

Sub LoopThroughFolder()

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Set Wb = ThisWorkbook

MyDir = "C:\Users\1256380\Desktop\New folder\"
MyFile = Dir(MyDir & "*.xls")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
On Error Resume Next
Do While MyFile <> ""
Workbooks.Open (MyFile)
With Worksheets("Sheet1")
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(.Cells(Rws, 1), .Cells(Rws, 9))
Wb.Worksheets("Sheet1").Range("A2").EntireRow.Insert
Rng.Copy Wb.Worksheets("Sheet1").Range("A2").EntireRow
ActiveWorkbook.Close True
End With
Application.DisplayAlerts = 1
MyFile = Dir()
Loop

End Sub

 

[Dossfm0q]

Sub LoopThroughFolder()

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Set Wb = ThisWorkbook

MyDir = Environ("userprofile") & "\Desktop\New folder\"
MyFile = Dir(MyDir & "*.xls")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
On Error Resume Next
Do While MyFile <> ""
Workbooks.Open (MyFile)
With Worksheets("Sheet1")
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(.Cells(Rws, 1), .Cells(Rws, 9)) 'Range(.Cells(Rws, 4), .Cells(Rws, 9))
Wb.Worksheets("Sheet1").Range("A2").EntireRow.Insert
Rng.Copy Wb.Worksheets("Sheet1").Range("D2") '.EntireRow
ActiveWorkbook.Close True
End With
Application.DisplayAlerts = 1
Application.ScreenUpdating = 1
MyFile = Dir()
Loop

End Sub