macro solution for last post and solution for
https://excelfox.com/forum/showthrea...ll=1#post13185
In the macro I have done for you , there are two possibilities.
You only need one
You can choose
' 2b)(i) Relative formula references ...
ORCode:' 2b)(i) Relative formula references ... 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
' 2b)(ii) Copy Paste
Code:' 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
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 SubCode:' http://www.excelfox.com/forum/showthread.php/1546-TESTING-Column-Letter-test-Sort Public Function CL(ByVal lclm As Long) As String ' http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980 Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0 End Function




Reply With Quote
Bookmarks