VBA Copy/Paste Offset Values Between Sheets

[Maui_Jim]

I am struggling with a macro that is designed to search a defined range for Values not equal to 5; then Copy/Paste Special certain Offset cells from the Active Cell.

The only element that continues to fail is my attempt to copy the Text Value in Column A of the Active Row. I have tried numerous OFFSET combinations and Row/Column objects; but the results range from no data being copied to Excel Errors.

In theory, I thought the declared variables should be able to resolve my issue; but then again, I was never real good with theories.

In the latest iteration, this code continues to prompt a ?Type Mismatch? (Code 13) error on this line:


Sheets("Status").Range("A65536").End(xlUp).Offset(1, 0) = Range("A" & rRow).Value

The entire code includes:


Sub StatusTest()
Dim rCell As Range
Dim rRow As Range
Dim rShift As Range

Set rRow = Sheets("Pump").Range("$B$3:$AC$4,$C$7:$AF$8,$B$11:$AE$12,$B$15:$AF$16,$B$19:$AE$20,$AF$48,$B$51:$ AC$52")

For Each rCell In rRow
If rCell <> 5 Then
Sheets("Status").Range("A65536").End(xlUp).Offset(1, 0) = Range("A" & rRow).Value
Sheets("Status").Range("B65536").End(xlUp).Offset(1, 0) = rCell.Offset(-2, 0).Value
Sheets("Status").Range("C65536").End(xlUp).Offset(1, 0) = rCell.Value
End If
Next rCell
End Sub

I would appreciate any assistance in providing an option to copy/paste the values in Column A, for every Row where a matched value (<> 5) is found.

Best regards,
Jim

[rbrhodes]

Hi Jim,

See the notes in the code below.



Sub StatusTest()
Dim rCell As Range
Dim rRow As Range
Dim rShift As Range

Set rRow = Sheets("Pump").Range("$B$3:$AC$4,$C$7:$AF$8,$B$11:$AE$12,$B$15:$AF$16,$B$19:$AE$20,$AF$48,$B$51:$ AC$52")

For Each rCell In rRow
If rCell <> 5 Then

'//This is an error!
'Since rRow is a range this should change to rRow.row or perhaps rCell.row if
' you're looking to return column A of the current row It cannot be
' Range("A") & rRow as that is an error eg: Range("A$B$3") is not correct!

Sheets("Status").Range("A65536").End(xlUp).Offset(1, 0) = Sheets("Pump").Range("A" & rCell.Row).Value

'//Since the first addresses of rRow are rows 3 and 4 this will return Rows 1 & 2 data
Sheets("Status").Range("B65536").End(xlUp).Offset(1, 0) = rCell.Offset(-2, 0).Value

'Simply returns the rCell value
Sheets("Status").Range("C65536").End(xlUp).Offset(1, 0) = rCell.Value
End If
Next rCell
End Sub

[Maui_Jim]

dr,

Thanks for taking your time to clarify this code for me. The last two Value statements are returning the data I need, but I had focused so keenly on the issue of extracting the first column for each active row that I could not step back and take a larger view.

Your comments have provided valuable insight that will allow me to pursue an better solution.

Kind regards,
Jim