Modify the code to copy more than one line and not copy repeateadly…

Hi All,

I have attached four workbooks. 3 from suppliers and one masterdata.
The three supplier’ workbooks are Supplier-a.xlsx, Supplier-b.xlsx, Supplier-c.xlsx and the master zMaster.xlsm
I am able to transfer the data from the suppliers’ workbooks to the master workbook, but, I have to hard code the number of lines.

I want to alter the code below to do two things
1. Be able to drag thousands of lines.
2. Update the lines that have been dragged to show “Yes” in column E and they are not dragged again.
Regards

Raghu

Sub LoopThroughDirectory()
Dim MyFile As String
Dim eRow As Long
Dim LastRow As Long
Dim FilePath As String
FilePath = ActiveWorkbook.Path & "\"
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (FilePath & MyFile)
' If Range("E2").Value = "" Then
Range("A2:D20").Copy
' End If
ActiveWorkbook.Close
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(eRow, 1), Cells(eRow, 4))
MyFile = Dir
ActiveWorkbook.Save
Loop
End Sub
Expert Asked on August 20, 2017 in Excel.
Add Comment
2 Answer(s)

HI Raghu,

Just wanted to understand your requirement more precisely. Please do let me know, If you have any unique id column in all files. So that based on unique id column we can check data is already available or need to add more record.

Regards-Valli

Expert Answered on August 20, 2017.
Add Comment

Hi I sorted it out…

 

Sub LoopThroughDirectory()
Dim MyFile As String
Dim eRow As Long
Dim fRowTBC As Long
Dim LastRow As Long
Dim i As Long
Dim FilePath As String
FilePath = ActiveWorkbook.Path & "\"
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (FilePath & MyFile)
eRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
fRowTBC = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
Debug.Print eRow
Debug.Print fRowTBC
For i = 2 To eRow
If Range("E" & i).Value = "" Then
Range("A" & fRowTBC & " : " & "D" & eRow).Copy
End If
Next
ActiveWorkbook.Close
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(eRow, 1), Cells(eRow, 4))
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (FilePath & MyFile)
eRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
fRowTBC = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
Debug.Print eRow
Debug.Print fRowTBC
For i = 2 To eRow - 1
If Range("E" & i).Value = "" Then
Range("E" & i).Value = Date
Columns("E:E").NumberFormat = "[$-C09]dd-mmm-yy;@"
End If
Next
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
MyFile = Dir
ActiveWorkbook.Save
Loop
End Sub

 

Thanks.

Expert Answered on September 7, 2017.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.