Loop through cells and copy cell contents to another worksheet

[Coldfire46]

Hi all,

In need of some help as I'm a bit of a vba novice:
I have a worksheets (entitled Summary 1, Summary 2, Summary 3 etc), I want to loop through the cells within each of the summary sheets and every time I come across a number, I want to copy that number into a new worksheet (entitled Compile Input Data).
I want to loop through data in cells G15:V15 in each summary sheet and then jump down a row (e.g. look through G16:V16 etc) until I get to the bottom of the data (which is indicated by a cell in column G containing the words "End"). When a number is found, I want to copy that value in column Q in the "Compile Input Data" worksheet, and generate a task ID for each row that is populated in this second worksheet.

Any advice would be really helpful; a starting off point would be great so that I can try to piece it together myself, see below for the code I've been trying (I know this is TOTALLY incorrect but it might give you an insight into what I'm trying to do)...
Thanks

If ws.Name Like "Summary-*" Then
For Each ws In Worksheets
Range("G15").Select
        For x = 7 To x = 22
            If Cells(15, x) <> "" Then
            Selection.Copy
            Sheets("Compile Input Data").Select
            Range("Q15").Select
            ActiveSheet.Paste
            End If
        Next x
Next ws

 

[lrobbo314]

Make sure to do this on a test copy of your worksheet.

Sub CID()
On Error GoTo erh

Dim ws      As Worksheet
Dim wsID    As Worksheet
Dim rID     As Long
Dim r       As Range
Dim cel     As Range

Set wsID = Sheets("Compile Input Data")
rID = wsID.Range("A" & Rows.Count).End(xlUp)

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "Summary*" Then
        Set r = ws.Range("G15", ws.Range("V" & ws.Rows.Count).End(xlUp))
            For Each cel In r
                If IsNumeric(cel) Then
                    wsID.Range("B" & Rows.Count).End(xlUp).Offset(1) = Val(cel)
                    rID = rID + 1
                    wsID.Range("A" & Rows.Count).End(xlUp).Offset(1) = rID
                End If
            Next cel
    End If
Next ws

Exit Sub

erh:
If Err.Number = 13 Then
    Resume Next
Else
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    Resume Next
End If

End Sub

My "Compile Input Data" sheet just has "ID" in A1 and "Result" in B1. Then the results are placed beneath those headers. You will need to adjust the code if you want it pasted somewhere else. Your original code is confusing to me because it will just keep pasting everything over itself in Q15.

Let me know if you have questions.

 

[lrobbo314]

I commented the code and changed the result column to start in Q with the ID showing up in the column to the right "R". Q14 and R14 must have the headers still.

Sub CID()
On Error GoTo erh

'Setting up variables
Dim ws      As Worksheet
Dim wsID    As Worksheet
Dim rID     As Long
Dim r       As Range
Dim cel     As Range

Set wsID = Sheets("Compile Input Data") 'Set worksheet variable = Compile Input Data sheet
rID = wsID.Range("A" & Rows.Count).End(xlUp) 'Set variable = last ID used on wsID sheet.  If it isn't a number, it will error and variable will remain a 0.

For Each ws In ActiveWorkbook.Worksheets 'Looping through worksheets
    If ws.Name Like "Summary*" Then 'Execute on sheets named Summary...
        Set r = ws.Range("G15", ws.Range("V" & ws.Rows.Count).End(xlUp)) 'Set range on worksheet
            For Each cel In r 'Loop through all cells in that range
                If IsNumeric(cel) Then 'If the cell's value is a number...
                    wsID.Range("Q" & Rows.Count).End(xlUp).Offset(1) = Val(cel) 'Found value in Summary Sheets
                    rID = rID + 1 'Increment ID
                    wsID.Range("R" & Rows.Count).End(xlUp).Offset(1) = rID 'ID for found value
                End If
            Next cel
    End If
Next ws

Exit Sub

erh:
If Err.Number = 13 Then
    Resume Next
Else
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    Resume Next
End If

End Sub

 

[Coldfire46]

Hi,

Many thanks for this. I really appreciate you taking the time to help me!
A couple of follow-up questions if you don't mind; when I run this code I get an error saying Type Mismatc, and the row of code starting with rID is highlighted in yellow, not sure what this means?
Also the Increment ID needs to follow the format OPS01, OPS02, OPS03 etc; is it possible to ensure that all the ids generated fit this pattern?

Thank you again