Results 1 to 10 of 15

Thread: Copy row from one workbook to another workbook based on conditions in another Workbook

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    Copy row from one workbook to another workbook based on conditions in another Workbook

    Code:
    Sub STEP6()
        Dim Wb1 As Workbook
        Dim Wb2 As Workbook
        Dim wb3 As Workbook
        Dim Ws1 As Worksheet
        Dim Ws2 As Worksheet
        Dim ws3 As Worksheet
        Dim strPath As String
        Dim r As Long
        Dim m As Long
        Dim rng As Range
        Dim n As Long
        Application.ScreenUpdating = False
        Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "1.xls")
        Set Ws1 = Wb1.Worksheets(1)
        m = Ws1.Range("H" & Ws1.Rows.Count).End(xlUp).Row
        strPath = ThisWorkbook.Path & ""
        Set Wb2 = Workbooks.Open(strPath & "OrderFormat.xlsx")
        Set Ws2 = Wb2.Worksheets(1)
        Ws2.Range("A1:A4").TextToColumns DataType:=xlDelimited, Tab:=True, _
        SemiColon:=False, Comma:=False, Space:=False, Other:=False, _
        ConsecutiveDelimiter:=False
        Set wb3 = Workbooks.Open(strPath & "BasketOrder..csv")
        Set ws3 = wb3.Worksheets(1)
        Set rng = ws3.Cells.Find(what:="*", searchorder:=xlByRows, SearchDirection:=xlPrevious)
        If rng Is Nothing Then
            n = 1
        Else
            n = rng.Row + 1
        End If
        For r = 2 To m
            If Ws1.Range("H" & r).Value > Ws1.Range("D" & r).Value Then
                Ws2.Range("A1").EntireRow.Copy Destination:=ws3.Range("A" & n)
                n = n + 1
            ElseIf Ws1.Range("H" & r).Value < Ws1.Range("D" & r).Value Then
                Ws2.Range("A3").EntireRow.Copy Destination:=ws3.Range("A" & n)
                n = n + 1
            End If
        Next r
        Application.DisplayAlerts = False
        Wb1.Close SaveChanges:=False
        Wb2.Close SaveChanges:=False
        wb3.SaveAs FileName:=strPath & "BasketOrder..csv", FileFormat:=xlCSV
        wb3.Close SaveChanges:=False
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End Sub
    Condition:If column H of 1.xls is greater than column D of 1.xls then copy third row of orderformat.xlsx & paste it to basketorder.xlsx
    If column H of 1.xls is smaller than column D of 1.xls then copy first row of orderformat.xlsx & paste it to basketorder.xlsx

    sample file attached below
    Attached Files Attached Files
    Last edited by DocAElstein; 07-26-2020 at 01:23 PM.

Similar Threads

  1. Replies: 2
    Last Post: 07-07-2020, 05:42 PM
  2. Replies: 101
    Last Post: 06-11-2020, 02:01 PM
  3. Replies: 4
    Last Post: 04-10-2014, 10:58 PM
  4. Replies: 2
    Last Post: 09-18-2013, 12:30 AM
  5. Replies: 2
    Last Post: 05-28-2013, 05:32 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •