CopyFromRecordset в объединенных ячейках

Question

Я пытаюсь переместить несколько запросов из базы данных доступа в Excel. Теперь один из этих запросов должен идти на одном листе с объединенными ячейками, но это меня неправильно меняет.

Код для запроса:

Public Sub CreateExcelInfo() 
'Set reference to Microsoft Excel Object library 
'Set reference to Microsoft ActiveX DataObject 2.x 

Dim oExcel As New Excel.Application 
Dim WB As New Excel.Workbook 
Dim WS As Excel.Worksheet 
Dim rng As Excel.Range 
Dim objRs5 As New ADODB.Recordset 
MsgBox ("Este proceso puede tardar unos minutos." & Chr(13) & Chr(13) & Chr(13) & "Por favor abstengase de realizar tareas en el equipo hasta ver el mensaje de finalizado."), vbOKOnly 
sFileNameTemplate = Application.CurrentProject.Path & "\templates\Informes.xlsm" 
sSQL5 = "SELECT [COMENTARIOS ÚLTIMO CIERRE].TipoComentarioInventario, [COMENTARIOS ÚLTIMO CIERRE].Comentario FROM [COMENTARIOS ÚLTIMO CIERRE] " 'Export comments last inventory 

With oExcel 
.Visible = True 
     Set WB = .Workbooks.Add(sFileNameTemplate) 
      With WB 
          objRs5.Open sSQL5, CurrentProject.Connection, adOpenDynamic, adLockReadOnly 
          Set rng = .Range("B24") 
          rng.CopyFromRecordset objRs5 
          objRs5.Close 
       End With 
      End With 

Set objRs5 = Nothing 
MsgBox ("!El informe se ha realizado correctamente!"), vbOKOnly 

End Sub 

Вот изображение с запросом и листом, теперь код работает так:

http://oi62.tinypic.com/2nu0xur.jpg

Answer 1

Простым Обходной сначала получите данные в excel, а затем выполните форматирование (и расчеты).

Unmerge клеток перед стадией .copyfromrecordset:

Rng.MergeCells = False 

, а затем повторно MERG клетки после

Rng.MergeCells = True 

Я хотел бы также отключить обновление экрана, так что не выглядит странным Пользователь.