Question

我正在尝试将数据从一个工作簿的工作表复制并粘贴到另一个工作簿（2个不同的工作簿）。但是，仅将数据粘贴到目标工作表上的未受保护的单元格中。两个工作表都具有相同的结构。得到你的帮助来调试它真是太棒了，这就是我到目前为止所做的：

 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

Answer 1

将源单元格拉入2-D变体数组。该阵列将具有与目标细胞矩阵相同的尺寸。

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

您自己的循环和值赋值需要以数字方式遍历单元格并分配值，而不是设置对象。

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

仅将数据粘贴到另一个工作簿的工作表上的未受保护（未锁定）单元格中

1 个答案: