VBA Copy Rows From One Workbook To text csv File Based On Count In Different Workbook. Cross Posted Chaos

**fixer** · 05-05-2020, 10:22 AM

**sandy666** · 05-05-2020, 11:37 AM

	B	D	G	L
2	NSE	6	A	GTT
3	NSE	6	A	GTT
4	NSE	6	A	GTT
5	NSE	6	A	GTT
6	NSE	6	A	GTT

I forgot to remove last column with numbers
result.csv.txt

this will be better because doesn't matter place where csv will be after open in Excel

NSE	6	A	GTT
NSE	6	A	GTT
NSE	6	A	GTT
NSE	6	A	GTT
NSE	6	A	GTT

out of curiosity: why result in csv format?

**fixer** · 05-05-2020, 11:47 AM

Bro what i have to do with this result.csv.txt
?

**fixer** · 05-05-2020, 11:50 AM

Code:

Sub Step14()    '    http://www.eileenslounge.com/viewtopic.php?f=30&t=34508 (zyxw123)     https://excelfox.com/forum/showthread.php/2467-COPY-AND-PASTE?p=13182#post13182
Rem 1 Worksheets info
Dim w1 As Workbook, w2 As Workbook, w3 As Workbook
 Set w1 = Workbooks("1.xls")                         ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xlsx")
 Set w2 = Workbooks("2.csv")                         ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\document\2.csv")
 Set w3 = Workbooks("3.xlsx")                        ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\files\3.xlsx")
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
 Set Ws1 = w1.Worksheets.Item(1)
 Set Ws2 = w2.Worksheets.Item(1)
 Set Ws3 = w3.Worksheets.Item(1)
Dim Lc3 As Long, Lenf1 As Long, Lr1 As Long
 Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row       '   http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466      Making Lr dynamic ( using rng.End(XlUp) for a single column. )
 Let Lc3 = Ws3.Cells.Item(1, Ws3.Columns.Count).End(xlToLeft).Column
Dim Lc3Ltr As String
 Let Lc3Ltr = CL(Lc3)
Rem 2  ' In 1.xls count the total number of rows that has data and copy the 3.xlsx sheet3 first row(first complete row copy) and paste that much time of 3.xlsx first row of sheet3 to 2.csv
 Let Lenf1 = Lr1 - 1                                                ' 1.xls first row has headers so dont count that
' 2a)
Dim rngOut As Range: Set rngOut = Ws2.Range("A1:" & Lc3Ltr & Lenf1 & "")
' 2b)(i)  Relative formula referrences  ... https://teylyn.com/2017/03/21/dollarsigns/#comment-191
 Ws2.Cells.NumberFormat = "General"                          ' May be needed to prevent formulas coming out as test     =[3.xlsx]Sheet1!$A$1
 Let rngOut.Value = "='[3.xlsx]" & Ws3.Name & "'!A$1"
 Let rngOut.Value = rngOut.Value  '  Change Formulas to values
 Let rngOut.Value = Evaluate("If({1},SUBSTITUTE(" & rngOut.Address & ", ""0"", """"))")      '                              https://excelribbon.tips.net/T010741_Removing_Spaces
' Or
' 2b)(ii) Copy Paste
Dim rngIn As Range
 Set rngIn = Ws3.Range("A1:" & Lc3Ltr & "1")
 rngIn.Copy
 rngOut.PasteSpecial Paste:=xlPasteValues  '   understanding  Paste  across ranges of different size to  Copy  range : https://excelfox.com/forum/showthread.php/2221-VBA-Range-Insert-Method-Code-line-makes-a-space-to-put-new-range-in?p=10441&viewfull=1#post10441

Rem 3
' w1.Close
' w2.Save
' Let Application.DisplayAlerts = False
' w2.Close
' Let Application.DisplayAlerts = True
' w3.Close
'
End Sub

This is the vba code Doc Sir gave me
Now plz have a look into this code and if any changes are required then plz let me know

**sandy666** · 05-05-2020, 11:53 AM

change result.csv.txt to result.csv and open with eg.Excel
btw. csv is NOT a native Excel format but IBM

I added txt on the end because this forum don't accept csv files

edit:
csv = comma separated values

**fixer** · 05-05-2020, 12:07 PM

I dont need csv files i need a macro that will do the process and i will get the result what i am looking for
i have a vba code that is slightly different but that code has pasted the data to csv i am sharing the same
dont get confuse i am sharing the code only to understand the probelm and solve this problem

Code:

Sub STEP3()
    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("A2").EntireRow.Copy Destination:=ws3.Range("A" & n)
            n = n + 1
        ElseIf ws1.Range("H" & R).Value < ws1.Range("D" & R).Value Then
            ws2.Range("A4").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

**sandy666** · 05-05-2020, 12:11 PM

sure, so I can't help
I did what you said in the first post without vba
have a nice day

**fixer** · 05-05-2020, 12:20 PM

That's Great Bro I like that & thnx for the same
Bro but i need that to be done by vba code this is my question & this is i am looking for
Thnx for ur Great Help & I like ur Attempt to solve this Problem
Relax Bro It will take time but i will resolve this problem & i will share the code with u
Have a Great Day

**fixer** · 05-05-2020, 02:51 PM

Doc Sir u have mentioned some code in this link https://excelfox.com/forum/showthrea...ll=1#post13184
i saw that but i am confused what i have to do now with this problem what exactly the code should be as per u