CODEWITHSUNDEEP
vbaexcel
Fábio Espadaneira
Fábio Espadaneira

Reputation: 15

Create a loop which copies the values from a specific range which match successive contidions to another worksheet

I have a workbook named "2017 Time Reports", which has 12 worksheets (each one with the name of each month of the year - from "January" to "December") and a support sheet named "ListFunc". In this support sheet, I registered basic information about my co-workers (starting on row 2), as follows:

a) In the 1st column, the worker's number (variable "NFunc"); b) In the 2nd column, the worker's name (variable "Name"); c) In the 3rd column, the worker's sector (variable "CodSector") - it goes from S1 to S7;

I intend to create a program that searches subsequently for each sector code and (since I have more than one worker for each sector), it will copy the worker's number and name (associated to each individual sector code) to any given month's worksheet. It would be something like: "Search for sector S1 and, for each entry, copy the worker's number and name" then "Search for sector S2 and, for each entry, copy the worker's number and name", and so on until I reached sector S7.

I tried to investigate a little bit and came across with a couple of solutions which allowed me to mount a program that ALMOST works great. It goes as follows (for now, I'll just define the variable "CodSector", since it's the only one I need in this code):

    Sub test()

    Application.Workbooks("2017 Time Reports").Activate

    Dim CodSector As Range
    Dim copyRange As Range
    Dim firstAddress As String
    Dim i As Integer
    Dim Row As Integer
    Row = 3

    Set CodSector = Worksheets("ListFunc").Range(Range("C1"), Range("C" & 
    Rows.Count))
    'So that, if I add a new worker, it will be considered the next time I 
    copy the range for another monthly sheet

    Dim ws, ws1 As Variant
    Set ws = Worksheets("ListFunc")
    Set ws1 = Worksheets(InputBox("Insert month in full"))

    For i = 1 To 7
        Set copyRange = CodSector.Find("S" & i, , , xlPart)

        If Not copyRange Is Nothing Then
            firstAddress = copyRange.Address
            Do
                ws1.Range(Cells(Row, 3), Cells(Row, 4)).Value = 
    Intersect(copyRange.EntireRow, ws.Columns("A:B")).Value
                'So that the result of the intersection in ws (worksheet 
    "ListFunc") is pasted in the given range of ws1 (worksheet "[Month of 
    the year]")
            Row = Row + 1
                Set copyRange = CodSector.FindNext(copyRange)

            Loop While copyRange.Address <> firstAddress
        End If
    Next i

    ws1.Activate

    End Sub

My problem is the following: In the expression ws1.Range(Cells(Row, 3), Cells(Row, 4)).Value = Intersect(copyRange.EntireRow, ws.Columns("A:B")).Value - If I change the beginning "ws1" for "ws" (which would mean that the result of the intersection in "ListFunc" worksheet would be pasted in the same worksheet), the code runs perfectly without any problem - but obviously that's not what I want. As it is right now, it keeps highlighting this line and giving me the following error:

Run time error '1004': Application-defined or object-defined error.

If there's someone with more expertise than me that find's out why this keeps giving this error and helps me solve it, it would be much appreciated!

Upvotes: 0

Views: 36

Answers (1)

braX
braX

Reputation: 11755

Fully qualify your generic Cells references to something like this: 

ws1.Range(ws1.Cells(Row, 3)

Without that, it assumes ActiveSheet which can cause problems.

Upvotes: 1

Related Questions