Page 1 of 2 12 LastLast
Results 1 to 10 of 15

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

  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.

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    Where does the original macro come from?
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  3. #3
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    I got this macro in 2019 & I have not remebered from which forum i got this macro
    Plz see the post I have mentioned all the details & sample file is also attached
    Last edited by fixer; 07-16-2020 at 07:43 PM.

  4. #4
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    Quote Originally Posted by fixer View Post
    I got this macro in 2019 & I have not remebered from which forum i got this macro
    So look for it and find it
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  5. #5
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Doc Sir I got this from expertsexchange I think so
    & I don't know exactly from which I'd I asked the question from so sorry for the same
    But I uploaded the sample file for this problem Sir & I mentioned the details too... Sir

  6. #6
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Unable to find the source of that macro Doc Sir
    So forget that macro Sir
    i have removed that macro bcoz it was working with .csv file & now i have replaced that file with .xlsx as per needs



    At that time i was unaware the .csv file file issue so thats y i replaced the .csv file from the process with .xlsx files
    So i need the macro of the same

  7. #7
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Last edited by fixer; 07-21-2020 at 02:14 PM.

  8. #8
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    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 r As Long
        Dim m As Long
        Dim rng As Range
        Dim n As Long
        Application.ScreenUpdating = False
        Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
        Set Ws1 = Wb1.Worksheets(1)
        m = Ws1.Range("H" & Ws1.Rows.Count).End(xlUp).Row
        Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\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("C:\Users\WolfieeeStyle\Desktop\BasketOrder.xlsx")
        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.Close SaveChanges:=True
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End Sub
    Problem Solved
    Thnx Alot Doc Sir for helping me in solving this problem
    Have a Awesome Day

  9. #9
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    Quote Originally Posted by fixer View Post
    .....
    I have removed that macro bcoz it was working with .csv file .....
    please don’t do major edits on posts, after anyone has replied. Minor changes, like correcting mistakes are OK, but do not remove or add a large amount. ( I did tell you about this before, but I expect you forgot )
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  10. #10
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    I reputted the data
    Sorry for the same Doc Sir

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
  •