Can't Bypass error Copy area and CopyPaste are not the same

MainFile.xlsmDataSource.xls

Hi guys,

I wrote code to copy data from one workbook that is closed and I need to paste it on the next available blank row in the workbook I am working in called "dashboard Shell1", but I keep getting the error message "The information cannot be pasted because the copy area and the copy paste area are not the same size" This is because the sheet I am working on where the data will be pasted is using merged cells (need to stay merge) [view image]
002- DASHBOARD.PNG


the data come from one Column in this sheet...
002- DATASHEET.PNG

here's the code I used, the error I mention comes in at the pasting part

 

Public Sub RetrieveData()

    'Retrieves Range A2:A100 from DHR Report and pastes it in Specified Range on Dashboard
    
    Dim wbDash              As Workbook 'workbook where the data is to be pasted
    Dim wbData              As Workbook 'workbook from where the data is to copied
    
    'take off alerts to avoid Save As pop up
    Application.ScreenUpdating = False
    
    Set wbDash = ActiveWorkbook  'Dashboard
    Set wbData = Workbooks.Open("C:\Users\673157897\Documents\Pro Fees Dash Board\Copy of RBC_CWM_DHR_Details_Report___Thomson__A (Preview).xls")
    
        'select cell A1 on the target book
            wbData.Sheets("Sheet1").Range("A2:A100").Copy
        'paste the data on the Dashboard book
           
Dim lst As Long
lst = wbDash.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row + 1

wbDash.Sheets("Data").Range("A" & lst).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
       
        'clear any thing on clipboard to maximize available memory
            Application.CutCopyMode = False
        'takes off alerts
            Application.DisplayAlerts = False
        'close the data book
            wbData.Close
        'activate the Dashboard file
            wbDash.Activate
      
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
    
End Sub

Please help someone!! Please

From the picture, none of those merged cells is necessary unless there is something to the far right side that you did not show us. You adjust the row height/width by using the cell format menu or just drag the row header separator bar on the left down as desired. My suggestion is to unmerge those cells, delete the empty rows and re-adjust the row height 'til it looks pretty. Merged cell on worksheets are always trouble.

Try this one:

Option Explicit
Public Sub RetrieveData()
    'Retrieves Range A2:A100 from DHR Report and pastes it in Specified Range on Dashboard
    Dim SOURCE          As Workbook 'workbook from where the data is to copied from
    Dim SrcSheet        As Worksheet
    Dim DESTINATION     As Worksheet 'workbook where the data is to be pasted to
    Dim NextRow         As Long
    Dim ContractorCount As Long
    Dim SourceArray()   As Variant
    Dim Contractor      As Variant
    
    'take off alerts to avoid Save As pop up
    Application.ScreenUpdating = False
    
    Set DESTINATION = ThisWorkbook.Sheets("destination")      'Dashboard
    NextRow = DESTINATION.Range("A1").CurrentRegion.Rows.Count + 1
    
    Set SOURCE = Workbooks.Open("C:\DOWNLOADS.NEW\DataSource(lougs7).xls")
    Set SrcSheet = SOURCE.Sheets("source data")
    ContractorCount = SrcSheet.Cells(Rows.Count, 1).End(xlUp).Row - 4
    
    'copy the contactor names to an array and close the source file without saving
    SourceArray = SrcSheet.Range("A5").Resize(rowsize:=ContractorCount).Value
    SOURCE.Close False
    
    For Each Contractor In SourceArray
        DESTINATION.Cells(NextRow, 1).Value = Contractor
        
        'copy the merged cell formats and paste to the last cell
        DESTINATION.Cells(NextRow, 1).Offset(-5).Resize(5).Copy
        DESTINATION.Cells(NextRow, 1).PasteSpecial Paste:=xlPasteFormats
        NextRow = NextRow + 5   ' 5 merged cells
    Next Contractor
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub