Need Help with Search...Copy...Paste Macro

[murphy00]

The data on sheets 1 thru 30 looks like this:

L 2800 33/2 PP2-1 CIRCUIT
3 el-swch
pd-recep

I want the macro to go through and find CIRCUIT in column G, copy cells A thru D on that row and paste to Worksheet("Circuit") on the next available row. I have most of the code done but keep running into errors. Could someone out there please look this over and offer some assistance?

Here is the code:

Sub Circuit()
    Dim oSheet As Variant
    Dim sht As Integer
    Dim Firstcell As Range
    Dim cRow As Integer
    Dim nRow As Integer
    Dim pRow As Integer
    Dim dest As Range
    Dim NextCell As Range
    Dim WhatToFind As Variant
        WhatToFind = "CIRCUIT"
        For sht = 1 To 30
        oSheet = "Sheet" & sht
            Worksheets(oSheet).Activate
            Worksheets(oSheet).[g1].Activate
            Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                If Not Firstcell Is Nothing Then
                cRow = Firstcell.Row
                pRow = Worksheets("Circuit").Range("A65536").End(xlUp).Offset(1, 0)
                dest = Worksheets("Circuit").Range("A" & pRow & ":D" & pRow)
                Range("a" & cRow & ":D" & cRow).Copy (dest)
                On Error Resume Next
                    While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
                    Set NextCell = Cells.FindNext(After:=ActiveCell)
                        If Not NextCell.Address = Firstcell.Address Then
                nRow = NextCell.Row
                pRow = Worksheets("Circuit").Range("A65536").End(xlUp).Offset(1, 0)
                dest = Worksheets("Circuit").Range("A" & pRow & ":D" & pRow)
                Range("a" & cRow & ":D" & cRow).Copy (dest)
                        End If
                    Wend
                End If
            Set NextCell = Nothing
            Set Firstcell = Nothing
            Next sht
End Sub

Thank you very much,
Murph

 

[Al Chara]

See if the following works:

Dim NextAvailableRow As String
CommandButton1.TakeFocusOnClick = False
NextAvailableRow = Intersect(Worksheets("Circuit").UsedRange, Worksheets("Circuit").Columns("A")).Offset(1, 0).Address
Set c = Worksheets(1).Columns("G").Find("CIRCUIT", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets("Sheet1").Range(Range(c.Address).Offset(0, -6), Range(c.Address).Offset(0, -3)).Value
NextAvailableRow = Range(NextAvailableRow).Offset(1, 0).Address
Set c = Worksheets(1).Columns("G").FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If

I wrote it quickly so bear that in mind.

 

[murphy00]

Al,

I tried the routine you gave me and I keep getting a 'Objet Variable or With Block Variable not set' on the line firstAddress = c.Address.

Here is the new routine.

Sub Circuit()
Dim NextAvailableRow As String
Dim oSheet As Variant
Dim sht As Integer
Dim c As Object
Dim firstAddress As Range
For sht = 1 To 30
oSheet = "Sheet" & sht
Worksheets(oSheet).Activate
Worksheets(oSheet).[g1].Activate
NextAvailableRow = Intersect(Worksheets("Circuit").UsedRange, Worksheets("Circuit").Columns("A")).Offset(1, 0).Address
Set c = Worksheets(oSheet).Columns("G").Find("CIRCUIT", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets(oSheet).Range(Range(c.Address).Offset(0, -6), Range(c.Address).Offset(0, -3)).Value
NextAvailableRow = Range(NextAvailableRow).Offset(1, 0).Address
Set c = Worksheets(1).Columns("G").FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next sht
End Sub


Thanks,
Murph

 

[Al Chara]

Don't dim firstaddress as range (it is a string). Use the code exactly as I gave you.

 

[murphy00]

Al,

Thank you very much!!!
It works great!
Is there any way to have it find all CIRCUIT on the first 30 sheets of the workbook?

Thanks,
Murph

 

[Al Chara]

Throw it all in a for loop where you have something like the following:

for i=1 to 30
worksheets(i)...
next

Make sure that the circuit worksheet is not one of the first 30 worksheets.

Try the following:

Dim NextAvailableRow, firstaddress As String
Dim c As Object
Dim i As Integer
NextAvailableRow = Intersect(Worksheets("Circuit").UsedRange, Worksheets("Circuit").Columns("A")).Offset(1, 0).Address
For i = 1 To 30
Set c = Worksheets(i).Columns("G").Find("CIRCUIT", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets(i).Range(Range(c.Address).Offset(0, -6), Range(c.Address).Offset(0, -3)).Value
NextAvailableRow = Range(NextAvailableRow).Offset(1, 0).Address
Set c = Worksheets(i).Columns("G").FindNext(c)
Loop While Not c Is Nothing And c.Address<> firstaddress
End If
Next


(you can get rid of your code that activates the sheet and cell; I wrote the code so you don't have to activate anything)

_________________
Hope this helps.
Kind regards, Al.
This message was edited by Al Chara on 2002-04-03 11:17

 

[murphy00]

Al,
I tried but it keeps giving me an error in this line:
Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets(i).Range(Range(c.Address).Offset(0, -6), Range(c.Address).Offset(0, -3)).Value
Any idea why? Could it be that I have to define a variable to add "Sheet" & i?

Thanks,
Murph

 

[Al Chara]

The code Worksheets(1) will look at the first worksheet in the workbook, Worksheets(2) will look at the second worksheet in the workbook, and so on. The following code should work if you have the thirty worksheets in order and Circuit is not one of the first thirty worksheets. You can also replace worksheets(i) with worksheets("Sheet" & i).

Dim NextAvailableRow, firstaddress As String
Dim c As Object
Dim i As Integer
NextAvailableRow = Intersect(Worksheets("Circuit").UsedRange, Worksheets("Circuit").Columns("A")).Offset(1, 0).Address
For i = 1 To 30
Set c = Worksheets(i).Range("G:G").Find("CIRCUIT", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
On Error Resume Next
Worksheets("Circuit").Range(Worksheets("Circuit").Range(NextAvailableRow), Worksheets("Circuit").Range(NextAvailableRow).Offset(0, 3)).Value = Worksheets(i).Range(Worksheets(i).Range(c.Address).Offset(0, -6), Worksheets(i).Range(c.Address).Offset(0, -3)).Value
NextAvailableRow = Range(NextAvailableRow).Offset(1, 0).Address
Set c = Worksheets("Sheet" & i).Columns("G").FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
Next