Paste Entire Row in D Column of master

kshitij_dch

Active Member
Joined
Apr 1, 2012
Messages
349
Office Version
  1. 365
  2. 2016
  3. 2007
Platform
  1. Windows
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

VBA Code:
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
 

Some videos you may like

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,594
Messages
5,625,693
Members
416,127
Latest member
MALEPINZON

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top