Macros - Select Row VBA

[BillHarris]

I have a macro which is supposed to copy and paste data from one worksheet to another, but is currently not working correctly, which reads;

Sub copytovision()


For x = 1 To 1000
If Cells(x, .Value = "Authorised" And Cells(x, 9).Value = "GJ" Then
Cells(x, .EntireRow.Select
Selection.Copy
Sheets("GJ").Select
Selection.End(xlDown).Offset(1, 0).EntireRow.Select
ActiveSheet.Paste
End If
Next x


End Sub

on running the Macro an error appears.

Run Time Error '1004'
Application-defined or Object-defined error

on the VBA degug the following is highlighted.

Selection.End(xlDown).Offset(1, 0).EntireRow.Select

It appears to be copying the required row from the worksheet "but is not pasting the data into the appropriate worksheet called "GJ"

Please help. Thanks!!!!!!!!!
This message was edited by BillHarris on 2002-08-13 09:17
This message was edited by BillHarris on 2002-08-13 09:27

 

[NateO]

Hi Bill. You actually won't want to select cells for this type of procedure. A .find method would be a little quicker, but with 1,000 rows, this loop should be alright. Here's what I came up with:<pre>
Sub copytovision2()
Dim cl As Range
For x = 1 To 1000
If Sheets("GJ").[a1] = "" Then
Set cl = Sheets("GJ").[a1]
ElseIf Sheets("GJ").[a2] = "" Then Set cl = Sheets("GJ").[a2]
Else: Set cl = Sheets("GJ").[a1].End(xlDown)(2)
End If
If Cells(x, 8).Value = "Authorised" And _
Cells(x, 9).Value = "GJ" Then _
Cells(x, 8).EntireRow.Copy _
cl
Next x
End Sub</pre>

Just be careful in that this code is using column A to determine the next available row, you could change A to H, etc....

Hope this helps.

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2002-08-13 10:08

 

[BillHarris]

Thanks to your response to my earlier query, which I have ammended to read.

Sub copytovision()
Dim cl As Range
For x = 1 To 1000
If Sheets("GJ").[a9] = "" Then
Set cl = Sheets("GJ").[a9]
ElseIf Sheets("GJ").[a10] = "" Then Set cl = Sheets("GJ").[a10]
Else: Set cl = Sheets("GJ").[a9].End(xlDown)(2)
End If
If Cells(x, 8).Value = "Authorised" And _
Cells(x, 9).Value = "GJ" Then _
Cells(x, 8).EntireRow.Cut _
cl
Next x
End Sub

I now however had create a seperate macro to delete the empty rows left on worksheet "Log", and reads thus;

Sub DELETEEMPTY()
Sheets("log").Select
Range("a2").End(xlDown).Offset(1, 0).EntireRow.Select
Selection.Delete shift:=xlUp
End Sub

Firstly, this macro is only deleting the first empty row, and not the remaining.How can this function be looped to include all blank rows on the worksheet.
Secondly, can this function be incorporated into the "copytovision" macro shown above. f so How??

Thanks once again.

 

[NateO]

Hi Bill, you're welcome!

Try inserting the following line of code before end sub in your copytovision procedure:<pre>
[a2:a65536].SpecialCells(xlCellTypeBlanks).EntireRow.delete</pre><pre></pre>
Hope this helps.

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2002-08-14 17:51