If the only change is to paste the data to Ws3, then I see just one error in your macro ,
Why have you changed to
For Cnt = 2 To Lr3 ?
It should still be
For Cnt = 2 To Lr2
The macro is going down rows in worksheet Ws2 from row 2 until the last row which is Lr2
My Lr22 = your Lr3 is the row count for data being pasted out : For each new data is needed a new row - the next row - the next row will be .. + 1
If the only change is to paste to Ws3 , then my original macro is only needed to be changed in 5 places
Code:Sub Step11b() ' http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste-by-VBA-based-on-criteria?p=13110&viewfull=1#post13110 http://www.excelfox.com/forum/showthread.php/2458-Copy-and-paste-the-data-if-condition-met Rem 1 Worksheets info Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook ' If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks, Workbooks(" ") Set Wb1 = ....... Workbooks("1.xls") ' Workbooks("1.xlsx") ' Workbooks("sample1.xlsx") ' Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls") ' w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls") ' change the file path If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks, Workbooks(" ") Set Wb2 = ....... Workbooks("2.xls") ' Workbooks("2.xlsx") ' Workbooks("sample2.xlsx") ' Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\FundsCheck.xlsb") ' w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\FundsCheck.xlsb") ' change the file path If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks, Workbooks(" ") Set Wb3 = ....... Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet ' Ws22 As Worksheet Set Ws1 = Wb1.Worksheets.Item(1) ' Set Ws1 = Wb1.Worksheets("anything") ' sheet name can be anything Set Ws2 = Wb2.Worksheets.Item(1) ' ' Set Ws2 = Wb2.Worksheets("anything") ' Set Ws22 = Wb2.Worksheets.Item(2) Set Ws3 = Wb3.Worksheets.Item(2) Dim Lr1 As Long, Lr2 As Long, Lr As Long, Lr22 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 Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row ' Let Lr = IIf(Lr2 > Lr1, Lr2, Lr1) Rem 2 do it Dim Cnt For Cnt = 2 To Lr2 Dim VarMtch As Variant Let VarMtch = Application.Match(CStr(Ws1.Range("I" & Cnt & "").Value), Ws2.Range("B2:B" & Lr2 & ""), 0) ' We look for the string value from each row in column I of Ws1 in the range of column B in Ws2 If Not IsError(VarMtch) Then ' If we have a match, then Application.Match will return an integer of the position along(down) where the match is found ' do nothing Else ' Application.Match will return a VB error string if no match could be found Ws1.Range("B" & Cnt & ",I" & Cnt & "").Copy ' if ranges are "in line" - that is to say have the same "width" ( in this example a single row width ) , then VBA lets us copy this to the clipboard Let Lr22 = Lr22 + 1 ' next free row in second worksheet of 2.xls 'Ws22.Range("A" & Lr22 & "").PasteSpecial Paste:=xlPasteValues ' Pasting of copied values which were "in line" allows us to paste out, but the missing in between bits ( columns in this example ) are missed out - the ranges are put together. Co incidentally we want this output in this example Ws3.Range("A" & Lr22 & "").PasteSpecial Paste:=xlPasteValues End If Next Cnt End Sub
or if you prefer to use a different variable for the row count in Ws3 , Lr3 , then
Code:Sub Step11b() ' http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste-by-VBA-based-on-criteria?p=13110&viewfull=1#post13110 http://www.excelfox.com/forum/showthread.php/2458-Copy-and-paste-the-data-if-condition-met Rem 1 Worksheets info Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook ' If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks, Workbooks(" ") Set Wb1 = ....... Workbooks("1.xls") ' Workbooks("1.xlsx") ' Workbooks("sample1.xlsx") ' Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls") ' w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls") ' change the file path If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks, Workbooks(" ") Set Wb2 = ....... Workbooks("2.xls") ' Workbooks("2.xlsx") ' Workbooks("sample2.xlsx") ' Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\FundsCheck.xlsb") ' w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\FundsCheck.xlsb") ' change the file path If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks, Workbooks(" ") Set Wb3 = ....... Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet ' Ws22 As Worksheet Set Ws1 = Wb1.Worksheets.Item(1) ' Set Ws1 = Wb1.Worksheets("anything") ' sheet name can be anything Set Ws2 = Wb2.Worksheets.Item(1) ' ' Set Ws2 = Wb2.Worksheets("anything") ' Set Ws22 = Wb2.Worksheets.Item(2) Set Ws3 = Wb3.Worksheets.Item(2) Dim Lr1 As Long, Lr2 As Long, Lr As Long, Lr3 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 Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row ' Let Lr = IIf(Lr2 > Lr1, Lr2, Lr1) Rem 2 do it Dim Cnt For Cnt = 2 To Lr2 Dim VarMtch As Variant Let VarMtch = Application.Match(CStr(Ws1.Range("I" & Cnt & "").Value), Ws2.Range("B2:B" & Lr2 & ""), 0) ' We look for the string value from each row in column I of Ws1 in the range of column B in Ws2 If Not IsError(VarMtch) Then ' If we have a match, then Application.Match will return an integer of the position along(down) where the match is found ' do nothing Else ' Application.Match will return a VB error string if no match could be found Ws1.Range("B" & Cnt & ",I" & Cnt & "").Copy ' if ranges are "in line" - that is to say have the same "width" ( in this example a single row width ) , then VBA lets us copy this to the clipboard Let Lr3 = Lr3+ 1 ' next free row in second worksheet of 2.xls 'Ws22.Range("A" & Lr22 & "").PasteSpecial Paste:=xlPasteValues ' Pasting of copied values which were "in line" allows us to paste out, but the missing in between bits ( columns in this example ) are missed out - the ranges are put together. Co incidentally we want this output in this example Ws3.Range("A" & Lr3 & "").PasteSpecial Paste:=xlPasteValues End If Next Cnt End Sub
Reply With Quote
Originally Posted by fixer
Bookmarks