Pasting data only into unprotected (unlocked) cells on a worksheet from another workbook

Question

I am trying to copy and paste data from one Workbook's sheet to another (2 different workbooks). However, only to paste data into the unprotected cells on the destination worksheet. Both worksheets have an identical structure. It would be awesome to get your help to debug this and here is what I've put together so far:

 Sub PasteData()

    Dim sourceWB As Workbook, targetWB As Workbook, sourceRange As Range, targetRange As Range, scell As Range, tcell As Range

    Set sourceWB = Workbooks.Open("Target.xlsx")
    Set sourceRange = sourceWB.Sheets("Tsheet").Range("D2:BE109")
    Set targetWB = Workbooks.Open("Source.xlsx")
    Set targetRange = targetWB.Sheets("Source").Range("D2:BE109")


   For Each tcell In targetRange
    For Each scell in Range sourceRange
      If Not tcell.Locked Then            
        If Not scell Is Nothing Then
                    Set tcell = scell
                End If
        End If
    Next scell
  Next tcell
End Sub

Nope no errors but I am just not seeing the data on the target workbook — ArsedianIvan
You are currently examining every cell in target for every cell in source. Instead of 5832 paired examinations you are making 5832² or 34,012,224 examinations. — user4039065

Unknown Unknown · Accepted Answer · 2018-02-22T06:01:35

Pull the source cells into a 2-D variant array. The array will have the same dimensions as the target cell matrix.

Sub PasteAPRA()

    Dim sourceWB As Workbook, sourceVals As variant
    dim targetWB As Workbook, targetRange As Range
    dim i as long, j as long

    Set sourceWB = Workbooks.Open("Target.xlsx", readonly:=true)
    sourceVals = sourceWB.Sheets("Tsheet").Range("D2:BE109").value2
    sourceWB.close savechanges:=false

    Set targetWB = Workbooks.Open("Source.xlsx")
    Set targetRange = targetWB.Sheets("Source").Range("D2:BE109")

    with targetRange 
       For i= lbound(sourcevals, 1) to ubound(sourcevals, 1)
           For j= lbound(sourcevals, 2) to ubound(sourcevals, 2)
               If Not .cells(i, j).Locked and not isempty(sourcevals(i, j)) Then            
                   .cells(i, j) = sourcevals(i, j)
               End If
           Next j
       Next i
    end with

End Sub

Your own loop and value assignment needs to numerically iterate through the cells and assign values, not Set objects.

dim c as long
For c=1 to targetRange.cells.count
    set tcell = targetrange.cells(c)
    set scell = sourceRange.cells(c)
    If Not tcell.Locked Then            
        If Not isempty(scell) Then
            tcell = scell.value
        End If
    End If
Next c

Pasting data only into unprotected (unlocked) cells on a worksheet from another workbook

1 Answers