Excel VBA copy and paste multiple ranges based on criteria in column not working with merged cells

Question

thanks for taking the time to read my question.

I have a workbook with 2 Sheets labeled "Sheet1" and "Sheet2".

On "Sheet1" I have ranges B14:G65, I14:I65, and merged range J14:J65 each merged cell in the merged range spans columns J:N or J14:N:14 through J65:N65.

I am needing to copy the values of the ranges that meet criteria in column F to "Sheet2" in the same range area.

I have the following macro that works great, except when it gets to the merged cells it errors. If the cells aren't merged it works fine. Hopefully someone can help me.

I can not use a row copy function as there are formulas in column H and P:AD that can't be overwritten and copying entire rows from Sheet1 overwrites it hence why I need the ranges.

Sub Test()
Dim rng As Range
Dim lastRow As Long
Dim cell As Variant
Dim count As Long
count = 0

With ActiveSheet.Previous
    lastRow = .Range("F" & .Rows.count).End(xlUp).Row
    Set rng = .Range("F14:F" & lastRow)

For Each cell In rng
    If cell.Value = "WIP" Or cell.Value = "WNS" Then
       Range(cell.Offset(0, -4), cell.Offset(0, 1)).Copy
       Range("B14").Offset(count, 0).PasteSpecial xlPasteValues
       Range(cell.Offset(0, 3), cell.Offset(0, 3)).Copy
       Range("I14").Offset(count, 0).PasteSpecial xlPasteValues
       Range(cell.Offset(0, 4), cell.Offset(0, 4)).Copy
       Range("J14").Offset(count, 0).PasteSpecial xlPasteValues
       count = count + 1
    End If
Next
End With
End Sub

Jason Adams Jason Adams · Accepted Answer · 2016-06-30T19:41:14

Think I figured out my own problem.

By changing the line

Range(cell.Offset(0, 4), cell.Offset(0, 4)).Copy
Range("J14").Offset(count, 0).PasteSpecial xlPasteValues

to

Range("J14").Offset(count, 0) = Range(cell.Offset(0, 4), cell.Offset(0, 4))

Excel VBA copy and paste multiple ranges based on criteria in column not working with merged cells

1 Answers