Copy merged cells and paste as values, fill resulting empty rows with duplicates

Question

I have code that will open a closed workbook, copy whole data from Worksheet "SM" and paste as values into target workbook "Paste SM" worksheet.

The data comes most of the time with some columns merged. After it has been copied and pasted as values, all merged cells are unmerged and there are some empty rows that need to be filled with duplicates.

Since I do not always receive documents with cells merged the code needs to work within scenarios:

Source Worksheet include merged cell through columns.
EX A1:A11 with value "QWERTY", A12:A23 with value "12345" etc.
Copied and paste as values - all unmerged - A1 - "QWERTY" A2-A11 blanks no value, A12 - "12345" A13-A23 blanks no value.
All blank cells to fill with duplicates, check whole worksheet.
Source Worksheet contains unmerged and merged cells.
Merged cells - same logic as for point 1.
Unmerged cells would look like A1 - "QWERTY" A2-A11 blanks no value, A12 - "12345" A13-A23 blanks no value in source worksheet.
It will remain same after copy and paste as values.
All blank cells to fill with duplicates, check whole worksheet.

Option Explicit

Public Sub Import_SM_DataFromAnotherWorkbook_and_Paste_As_Values()
    ' Get workbook...
    Dim targetWorkbook As Workbook
    Set targetWorkbook = Application.ThisWorkbook

    ' get the customer workbook
    Dim Filter As String
    Filter = "Text files (*.xlsb),*.xlsb,(*.xlsx),*.xlsx"

    Dim Caption As String
    Caption = "Please Select an input file "

    Dim Ret As Variant
    Ret = Application.GetOpenFilename(Filter, , Caption)

    If VarType(Ret) = vbBoolean And Ret = False Then Exit Sub

    Dim wb As Workbook
    Set wb = Workbooks.Open(Ret)

    'It will open source woorkbook, copy whole sheet and paste as values into current workbook. Will 
     close sourcebook afterwards
    targetWorkbook.Worksheets("Paste SM").Range("A1").Resize(wb.Worksheets("Security Matrix").UsedRange.Rows.Count, wb.Worksheets("Security Matrix").UsedRange.Columns.Count).Value = wb.Worksheets("Security Matrix").UsedRange.Value

    'close opened workbook without saving
    wb.Close SaveChanges:=False
End Sub

LletDeCabra LletDeCabra · Accepted Answer · 2020-12-04T11:36:56

instead of copy and paste all the new data to a new worksheet, you should create an array with all the data. Check all the values of the array and if it's empty, copy the value from the row above.

Option Base 1 'make the array starts at 1 instead of 0. This is helpful because you are working as it was a range
Dim ArrayNewData(), NewRange As Range, RangeNewData As Range
Dim i%, j%
Sub Test()

'when open the new worksheet
With wb.Sheets("SM")
    Set RangeNewData = .Cells(1, 1).CurrentRegion 'set the range you want to copy
End With
ArrayNewData = RangeNewData 'save the copied range to an array.

'now you can close the wb
wb.Close SaveChanges:=False

'The size of the array is
    'Rows:lbound(ArrayNewData) x ubound(ArrayNewData)
    'Columns: lbound(application.transpose(ArrayNewData)) x ubound(application.transpose(ArrayNewData))
'all the "cells" in the array aren't merged
'so now, you can fill the empty "cells" of the array with the value above
For i = 2 To UBound(ArrayNewData) 'check all the rows starting from the 2nd (just because if the 1st one is empty, there's nothing to copy above
    For j = 1 To UBound(Application.Transpose(ArrayNewData)) 'and check all the columns
        If IsEmpty(ArrayNewData(i, j)) = True Then 'if the cell is empty...
            ArrayNewData(i, j) = ArrayNewData(i - 1, j) 'the value will be the one row above
        End If
    Next j
Next i
'Now you've got the array of values ArrayNewData.

'Now set a new range to where you want to copy them. Maybe, you don't need to copy all of them, andkeep working with the array.
'The more interactions you do between VBA and excel, the more slow will work everything.

With Sheets("Paste SM")
    Set NewRange = .Range(.Cells(1, 1), .Cells(UBound(ArrayNewData)), UBound(Application.Transpose(ArrayNewData)))
End With
NewRange = ArrayNewData
End Sub

Copy merged cells and paste as values, fill resulting empty rows with duplicates

1 Answers