Copying Cells from Column B:D in Sheet1 to C:E in Sheet2 based on Row Number - excel

Question

I have a worksheet (Sheet2) where there are pasted rows at Columns B:D at different row numbers.
These row numbers actually correspond with the row numbers in worksheet (Sheet1) which are blank and I wish to paste the cells dynamically into Columns C:E.
I have the following code which allows me to copy the row from Columns B:D based on a text value = "LAW" and paste in Sheet1 as long as I know the range of the cell in Column C.
I suppose what I am looking for is the equivalent of when "LAW" is found, match the row with the one in Sheet1 and paste at Column C. A loop is necessary as there are other instances where "LAW" is found and these cells need to be pasted at the appropriate cell range.
Dim WBT As Workbook
Dim WSD1 As Worksheet
Dim WSD2 As Worksheet
Set WBT = Workbooks("Invoices.csv")
Set WSD1 = WBT.Worksheets("Sheet1")
Set WSD2 = WBT.Worksheets("Sheet2")
Set r2 = WSD1.Range("C11")
With WSD2
N = .Cells(Rows.Count, "B").End(xlUp).row
For i = 1 To N
If .Cells(i, "B").Value = "LAW" Then
Set r1 = Range(.Cells(i, "B"), .Cells(N, "D"))
r1.Copy r2
End If
Next i
End With
I found it rather difficult to come up with a failsafe solution however, I hope someone can give me a few pointers as how I should go about this.
The example below demonstrates that I want to look for the rows in Sheet2 and paste them at the highlighted points in Sheet1. If there is a way of dynamically saying If Text in Column B on Sheet2 = LAW then copy that row (from Columns B to D) to the equivalent row in Sheet1. In my example I have two instances where this occurs.
Following the success of the amendment to the script by #SJR I then struck a problem where the Workbook had many many sheets. So I modified the code and used a function to test if a sheet exists (default is Not)
Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(sht)
On Error Resume Next
SheetExists = Not sht Is Nothing
End Function
and duplicated the code as follows:
Dim r1 As Range
Dim r2 As Range
Dim N As Long
Set r2 = WSD1.Range("C1:C100")
With WSD2
If Not SheetExists("Sheet1") Then
N = .Cells(Rows.Count, "B").End(xlUp).row
For i = 1 To N
If .Cells(i, "B").Value = "LAW" Then
Set r1 = Range(.Cells(i, "B"), .Cells(i, "D"))
r1.Copy WSD1.Cells(i, "C")
End If
Next i
Else
On Error Resume Next
End If
End With
With WSD3
If Not SheetExists("Sheet2") Then
N = .Cells(Rows.Count, "B").End(xlUp).row
For i = 1 To N
If .Cells(i, "B").Value = "LAW" Then
Set r1 = Range(.Cells(i, "B"), .Cells(i, "D"))
r1.Copy WSD1.Cells(i, "C")
End If
Next i
Else
On Error Resume Next
End If
End With
Although this works fine where the workbook has 2 sheets it falls over on the second script referencing WSD3 at N = .Cells(Rows.Count, "B").End(xlUp).rowwith run time error '91'. By stepping through the code I find that the variable for R1 comes up with the message if you hover over the Range???? Although I tried to figure out why it is saying the variable is not set I am confused.

Answer 1

Can you try this? Think you had an errant N in the line assigning r1.
Sub x()
Dim WBT As Workbook
Dim WSD1 As Worksheet
Dim WSD2 As Worksheet, N As Long
Set WBT = Workbooks("Invoices.csv")
Set WSD1 = WBT.Worksheets("Sheet1")
Set WSD2 = WBT.Worksheets("Sheet2")
Set r2 = WSD1.Range("C11")
With WSD2
N = .Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To N
If .Cells(i, "B").Value = "LAW" Then
Set r1 = .Range(.Cells(i, "B"), .Cells(i, "D"))
r1.Copy WSD1.Cells(i, "C")
End If
Next i
End With
End Sub