Find and copy multiple occuring values

[Timotheus]

Dear fellow members,

While I was making a workbook in Excel I faced the following problem.
Sheet "Technische gegevens" contains a variable amount of tables. Each table has a subtotal which represents the sum of different surfaces (the file concerns rooms in buildings). What I'm trying to do is to search all these subtotals and then copy them to sheet "Rapport brandveiligheid") underneath eachother. After these subtotals are copied there still has to be a possibilty to change the values in "Technische gegevens" and that the values in "Rapport brandveiligheid" are updated to these changes.
I was trying to create a test module that I eventually want to transform in a change event. Problem is that the current code doesn't cause any errors but when I click on a button to test it, nothing happens.

Sub MyOffset3()
With Range("C1:C65536")
Set c = .Find(What:="Subtotaal=", LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Offset(0, 1).Copy
Sheets("Rapport brandveiligheid").Select
Range("Kop2_doorstroomcapaciteit").Offset(-2, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

Could someone please tell me why the code doesn't seem to do anything. I searched in forum but couldn't find a similar problem.
Many thanks in advance!

 

[pboltonchina]

you have a simple spelling mistake

Sub MyOffset3()
With Range("C1:C65536")
Set c = .Find(What:="[B][COLOR="Red"]Subtotaal[/COLOR][/B]=", LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Offset(0, 1).Copy
Sheets("Rapport brandveiligheid").Select
Range("Kop2_doorstroomcapaciteit").Offset(-2, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

Is that your cell value or should it be Subtotal?

 

[Timotheus]

Thanks for your quick answer. I'm afraid it's not a spelling mistake. It is indeed my cell value. The situation is that each table has a cell with text "subtotaal=" (it's the Dutch translation for subtotal). The cell next to this cell contains a numeric value that I want to copy to the other worksheet.
I'm also curious if someone perhaps has a whole other approach to this issue.

 

[pboltonchina]

Try this on a copy or your data

Option Explicit

Sub CopyData()
 
Application.ScreenUpdating = False
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
    For i = LR To 9 Step -1
    If Range("C" & i).Value = "Subtotaal=" Then
    Rows(i).Select
    Selection.Copy
    Worksheets("Rapport brandveiligheid").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
    End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
 End Sub

 

[Timotheus]

Dear pboltonchina,

The code you posted helped me out a little bit but it didn't do would I'm looking for. I made a new code that looks like it has all the actions written in it that it has to undertake but until now i've had know luck adjusting it to make it work. The code goes as follows:

Sub Find()
Dim Stotaal As Range
For Each Stotaal In Range("C1:C65536")
If Stotaal.Value = "Subtotaal =" Then
Stotaal.Offset(0, 1).Select
Selection.Copy
Sheets("Rapport brandveiligheid").Select
Range("Kop_persoonsbenadering").Offset(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Exit For
End If
Next Stotaal
End Sub

The code got the first subtotal from the first table but somehow the loop doesn't seem to be working. The current code doensn't work with a negative offset anymore. I can imagine that the first code can be a bit confusing.
To summerize the original problem for all other readers: a macro has to find all subtotals in a range that consists of multiple tables in which the subtotals are found. The user can insert new tables. This creates a dynamic range in which the macro has to search. I stumbled upon varies options using if-statements or using the .find-method but but until now I haven't been able to adjust those examples to make it work with my macro.

 

[Timotheus]

.

 

[Timotheus]

With some searching and adjusting I found a working code. It goes as follows:

Sub Copy_To_Another_Sheet_1()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim Rcount As Integer
    Dim Kop As Integer
    Dim H As Long
    Dim NewSh As Worksheet
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    MyArr = Array("Subtotaal =")
    Set NewSh = Sheets("Rapport brandveiligheid")
    With Sheets("Technische gegevens").Range("C1:C65536")
        Rcount = 0
        For H = LBound(MyArr) To UBound(MyArr)
            Set Rng = .Find(What:=MyArr(H), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1
                    Kop = Range("G.O._persoonsbenadering").Offset(-1, 1).Row
                    Rng.Offset(0, 1).Copy
                    NewSh.Range("B" & Kop + Rcount).PasteSpecial Paste:=xlPasteValues
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next H
    End With
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Nonetheless I'd like to thank pboltonchina for your time and effort!