Macro help needed

K

K

I am trying to make below macro work but there is something not
correct. I am getting error on line

Worksheets("Sheet3").Cells(row3, Range("A" & row3 & ":C" & row3)) =
Worksheets("Sheet1").Cells(row1, Range("B" & row1 & ":D" & row1))

Please can any body can help

Sub CheckInfo()
Dim row1, row2, row3 As Integer
row3 = 2 ' Sheet3
row2 = 2 ' Sheet2
While Worksheets("Sheet2").Cells(row2, 1) <> ""
row1 = 2 ' Sheet1
While Worksheets("Sheet1").Cells(row1, 1) <> ""
If Worksheets("Sheet1").Cells(row1, 1) = Worksheets("Sheet2").Cells
(row2, 1) Then
Worksheets("Sheet3").Cells(row3, Range("A" & row3 & ":C" & row3)) =
Worksheets("Sheet1").Cells(row1, Range("B" & row1 & ":D" & row1))
row3 = row3 + 1
End If
row1 = row1 + 1
Wend
row2 = row2 + 1
Wend
End Sub
 
L

Lars-Åke Aspelin

I am trying to make below macro work but there is something not
correct. I am getting error on line

Worksheets("Sheet3").Cells(row3, Range("A" & row3 & ":C" & row3)) =
Worksheets("Sheet1").Cells(row1, Range("B" & row1 & ":D" & row1))

Please can any body can help

Sub CheckInfo()
Dim row1, row2, row3 As Integer
row3 = 2 ' Sheet3
row2 = 2 ' Sheet2
While Worksheets("Sheet2").Cells(row2, 1) <> ""
row1 = 2 ' Sheet1
While Worksheets("Sheet1").Cells(row1, 1) <> ""
If Worksheets("Sheet1").Cells(row1, 1) = Worksheets("Sheet2").Cells
(row2, 1) Then
Worksheets("Sheet3").Cells(row3, Range("A" & row3 & ":C" & row3)) =
Worksheets("Sheet1").Cells(row1, Range("B" & row1 & ":D" & row1))
row3 = row3 + 1
End If
row1 = row1 + 1
Wend
row2 = row2 + 1
Wend
End Sub


Try replacing the assignment statement with these two statements::

Worksheets("Sheet1").Range("B" & row1 & ":D" & row1).Copy
Worksheets("Sheet3").Paste Destination:=Worksheets("Sheet3").Range("A"
& row3)

You should also enter the following at the end of the macro

Application.CutCopyMode = False

This is the modified macro:

Sub CheckInfo()
Dim row1, row2, row3 As Integer
row3 = 2 ' Sheet3
row2 = 2 ' Sheet2
While Worksheets("Sheet2").Cells(row2, 1) <> ""
row1 = 2 ' Sheet1
While Worksheets("Sheet1").Cells(row1, 1) <> ""
If Worksheets("Sheet1").Cells(row1, 1) = Worksheets("Sheet2").Cells
(row2, 1) Then
Worksheets("Sheet1").Range("B" & row1 & ":D" & row1).Copy
Worksheets("Sheet3").Paste Destination:=Worksheets("Sheet3").Range("A"
& row3)
row3 = row3 + 1
End If
row1 = row1 + 1
Wend
row2 = row2 + 1
Wend
Application.CutCopyMode = False
End Sub

Hope this helps / Lars-Åke
 
J

john

not tested but see if this helps:

Sub CheckInfo()
Dim row1, row2, row3 As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")

row3 = 2 ' Sheet3
row2 = 2 ' Sheet2

While ws2.Cells(row2, 1).Value <> ""


row1 = 2 ' Sheet1

While ws1.Cells(row1, 1).Value <> ""

If ws1.Cells(row1, 1).Value = ws2.Cells(row2, 1).Value Then

ws3.Range("A" & row3 & ":C" & row3).Value = _
ws1.Range("B" & row1 & ":D" & row1).Value

row3 = row3 + 1

End If

row1 = row1 + 1

Wend

row2 = row2 + 1

Wend

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top