Search code examples
excelvba

VBA Excel loop copying data unmerges the row

I have the data in the range of cells, which is merged.

Despite using correct code, the range is initially unmerged and then copied as unmerged down to the next rows. Despite using MergeCells = True the ranges aren't merged back.

 Sub NAD_Sheet()

 Dim i As Long
 Dim rg As Range, rg2 As Range
 Dim ws1 As Worksheet, ws2 As Worksheet
 Dim Lastrow As Integer, j As Integer

 Set ws1 = ThisWorkbook.Sheets("All-Points Frontsheet")
 Set ws2 = ThisWorkbook.Sheets("Adr")

 Set rg = ws1.Range("E34")
 Set rg2 = ws2.Range("B3:Q3")

 ws2.Range("A4:Q500").ClearContents

 For i = 1 To rg
    rg2.Copy _
    Destination:=ws2.Range("B3").Resize(rowSize:=rg.Value - 1)
    'Destination:=ws2.Range("B3").Resize(rowSize:=rg.Value - 1)
    ws2.Range("D" & i & ":F" & i).MergeCells = True
 Next I

 End Sub

What might cause this problem? Is there something wrong with Excel? I have columns unmerged even if the new row is inserted.

enter image description here

Solution

  • In testing this works fine for me:

    Sub NAD_Sheet()

    Dim ws1 As Worksheet, ws2 As Worksheet, numRows As Long
     
    Set ws1 = ThisWorkbook.Sheets("All-Points Frontsheet")
    Set ws2 = ThisWorkbook.Sheets("Adr")
    
    ws2.Range("A4:Q500").Clear
    numRows = ws1.Range("E34").Value
    
    ws2.Range("B3:Q3").Copy ws2.Range("B4").Resize(numRows - 1)
     
End Sub