• Ask a Question
150
Insert Image Size must be less than < 5MB.
    Ask a Question
    Cancel
    150
    More answer You can create 5 answer(s).
      Ask a Poll
      Cancel
      Expert

      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
      
      Asked by raghuprabhu on August 20, 2017 in Excel.
      2 Answers
      Expert

      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

      Answered by Valli on August 20, 2017..
      Expert

      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.

      Answered by raghuprabhu on September 7, 2017..