How to paste a line at a time?

Copy & paste using vba

• QUESTION: I have 3 different workbooks open. Workbook 3 contains the macro I want to run. The other 2 workbooks have wild card characters in the name since it changes every week/month. I am trying to copy and paste from "*Book MK*" to "*Book SW*" by using a macro in Workbook 3. Below code doesn't seem to do anything, not even an error message: Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("n2")) Is Nothing Then Dim dateAndTime As String Dim staffingLevel Dim wb As Workbook Dim ws As Worksheet Dim rCell As Range Dim wbs As Workbooks Dim fname1 As String Dim fname2 As String Dim wb1 As Workbook Dim wb2 As Workbook For Each wb In Application.Workbooks If wb.Name Like "*Book MK*" Then wb.ActiveSheet.Activate wb.ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Offset(-1).Resize(2, 21).Copy Range("C47") wb.ActiveSheet.Cells(1).Select If wb.Name Like "*Book SW*" Then wb.ActiveSheet.Activate wb.Activate Range("B" & Rows.Count).End(xlUp).Select.Offset(1).PasteSpecial Paste:=xlPasteValues End If End If Next End If End Sub Then I tried this code: Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("n2")) Is Nothing Then Dim dateAndTime As String Dim staffingLevel Dim wb As Workbook Dim ws As Worksheet Dim rCell As Range Dim wbs As Workbooks Dim fname1 As String Dim fname2 As String Dim wb1 As Workbook Dim wb2 As Workbook fname1 = wb.Name Like "*Book MK*" Set wb1 = Workbooks.Open(fname1) fname2 = wb.Name Like "*Book SW*" Set wb2 = Workbooks.Open(fname2) wb1.ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Offset(-1).Resize(2, 21).Copy wb2.ActiveSheet.Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If End Sub This code gives me error 91, Object variable or With block variable not set. I am only a beginner in VBA and Excel, so please forgive me if I asked something impossible or if above is totally wrong. Bert. ANSWER: Bert, You need to establish both the from and to workbooks prior to trying to do anything. Once you have that, try to do the copy and paste with no extra code in between. Private Sub Worksheet_Change(ByVal Target As Range) Dim wb As Workbook Dim wb1 As Workbook Dim wb2 As Workbook If Not Intersect(Target, Range("n2")) Is Nothing Then For Each wb In Application.Workbooks If wb.Name Like "*Book MK*" Then set wb1 = wb end if If wb.Name Like "*Book SW*" Then set wb2 = wb end if Next ' the next line should refer to the last cell in column B with ' a value and the blank cell below resized to 21 columns wide wb1.ActiveSheet.Cells(Rows.Count, "B") _ .End(xlUp).Offset(-1).Resize(2, 21).Copy wb2.ActiveSheet.Range("B" & Rows.Count) _ .End(xlUp)(1).PasteSpecial Paste:=xlPasteValues End if End Sub Untested, but I would expect that to work. ---------- FOLLOW-UP ---------- QUESTION: First of all, thank you so much for your quick response and secondly for your solution. I have been working on this problem for days and after using your code it works like a charm. However, if you do not mind, can I ask you another question related to this problem and maybe I should have mentioned it in my first post. Is it possible to paste the data when the cells contain a 0 because my spreadsheet looks like below; 58 79 15610 985 161 0 18576 374 0 3 0 1541 1620 269 23 17209 92.6% 10 87.3% 29 57 7432 189 81 0 8988 489 0 5 0 1262 1319 256 21 8248 91.8% 5 89.7% 100 149 27507 2063 261 23 33864 659 1 4 2 2706 2855 270 51 30662 90.5% 19 84.5% 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 I hope I am not asking for the impossible. Again, thank you so much for your help. You make everything look so easy. ANSWER: Bert, this line wb1.ActiveSheet.Cells(Rows.Count, "B") _ .End(xlUp).Offset(-1).Resize(2, 21).Copy goes to the bottom of column B, hits the End key and the up arrow. It stops on the last non empty cell in column B. So I would expect it to copy the last row that has data in it. Perhaps you could elaborate on what you think the problem is or send some dummy workbooks to me that recreate the situation and explain where you think it isn't working. So the value of the cell is not considered by the code. Only whether the cell had data or doesn't have data. Your example appears to right align. If it should have shown that column B was empty where you show zeros then perhaps the code should do the checking for the bottom in column C. then the line wb1.ActiveSheet.Cells(Rows.Count, "B") _ .End(xlUp).Offset(-1).Resize(2, 21).Copy would need to be wb1.ActiveSheet.Cells(Rows.Count, "C") _ .End(xlUp).Offset(-1,-1).Resize(2, 21).Copy if you need to send some workbooks, send to ---------- FOLLOW-UP ---------- QUESTION: I am so sorry about my poor explanation. The code you sent me the first time around works excellent. It exactly copies from and paste to the cells you described above. The additional problem I have is, the cells that the data needs to be pasted in have a default value of 0. The rows in my spreadsheet looks like: Row 1: 12 25 78 59 79 47 Row 2: 34 56 78 46 73 45 Row 3: 0 0 0 0 0 0 Row 4: 0 0 0 0 0 0 Row 5: 0 0 0 0 0 0 Row 6: 0 0 0 0 0 0 Can it be pasted in Row 3 and 4 and the time after that in Row 5 and 6, etc. Many

• Answer:

  Bert, so I will assume that I can paste to the first cell in column B that contains a zero. If not tell me what I must check for. Private Sub Worksheet_Change(ByVal Target As Range) Dim wb As Workbook Dim wb1 As Workbook Dim wb2 As Workbook Dim sh2 as worksheet, r2 as range, cell as range Dim r3 as Range If Not Intersect(Target, Range("n2")) Is Nothing Then For Each wb In Application.Workbooks If wb.Name Like "*Book MK*" Then set wb1 = wb end if If wb.Name Like "*Book SW*" Then set wb2 = wb end if Next set sh2 = wb2.Activesheet set r2 = wb2.Range("B1",wb2.cells(1,2).End(xldown)) for each cell in r2 if cell.value = 0 then set r3 = cell exit for end if Next ' the next line should refer to the last cell in column B with ' a value and the blank cell below resized to 21 columns wide wb1.ActiveSheet.Cells(Rows.Count, "B") _ .End(xlUp).Offset(-1).Resize(2, 21).Copy ' wb2.ActiveSheet.Range("B" & Rows.Count) _ ' .End(xlUp)(1).PasteSpecial Paste:=xlPasteValues r3.pasteSpecial paste:=xlPasteValues End if End Sub But is still bothers me that it looks like we are copy ing a filled row and a blank row from the source sheet. If that is the case, then once it is copied over the first time, it would overwrite one of your zero value in column B and the next time a copy is made you would have a blank row in the destination sheet. So I might need to better understand what the situation is. Even if the second row is not totally blank, I would think it would be at least in column B because of the way the code determines what row(s) to copy. Make sure you test this on a copy of your workbook and let me know if there are problems. -- Regards. Tom Ogilvy