Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)

[DocAElstein]

Some notes related to these posts
https://excelfox.com/forum/showthrea...ll=1#post13318
http://www.eileenslounge.com/viewtopic.php?f=30&t=34610
http://www.eileenslounge.com/viewtop...267706#p267706

---

VBA To Copy Rows From One Workbook To text csv File, Based On Count In A Different Workbook

Question
I have three files 2 Excel Files,1.xls & 3.xlsx , and a text file, 2.csv
1.xls first row has headers so don't count that
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 many rows of 3.xlsx first row of sheet3 to 2.csv
suppose 1.xls has data in 5 rows then copy 3.xlsx first row of sheet3 and paste it to 2.csv 5 times
all files are located in a different path
sheet name can be anything

The final result should be a comma separated values text file , 2.csv.
For example, in Notepad, it looks like this:
2csv is a comma seperated text file.JPG : https://imgur.com/FEjKVMs
Attachment 2935

That is the final result that I want

---

Answer:

Sub Step14() '     https://excelfox.com/forum/showthread.php/2467-VBA-To-Copy-Rows-From-One-Workbook-To-text-csv-File-Based-On-Count-In-A-Different-Workbook?p=13367&viewfull=1#post13367        '    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.Open(ThisWorkbook.Path & "\1.xls")  ' Workbooks("1.xls")                         ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xlsx")
 Set w2 = Workbooks.Open(ThisWorkbook.Path & "\2.csv")  ' Workbooks("2.csv")                         ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\document\2.csv")
 Set w3 = Workbooks.Open(ThisWorkbook.Path & "\3.xlsx")  ' 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
' 3a
 w1.Close
 w3.Close
' 3b
w2.SaveAs Filename:=ThisWorkbook.Path & "\2.csv", FileFormat:=xlCSV
 Let Application.DisplayAlerts = False
 w2.Close
 Let Application.DisplayAlerts = True

End Sub