首页 > 解决方案 > 将特定单元格从已关闭的工作簿复制到我的 ActiveWorkbook

问题描述

我正在寻找打开一个封闭的工作簿,按顺序将单元格 G8、F8、E8、D8、C8 复制到我的 ActiveWorkbook 单元格 G8、G9、G10、G11、G12 中。目前,我编写了一个代码,将打开关闭的工作簿复制单元格 G8 值并将其粘贴到活动簿 G8。这实际上有效,但我的代码正在将数据复制到 G8 以外的单元格中。

我如何专门只复制到这些单元格?我需要包含select在我的代码中吗?

Dim x As Workbook
Dim y As Workbook
Dim vals As Variant


Set x = Workbooks.Open("C:\x\xx\xx\Folder\File.xls")


Set y = ActiveWorkbook

vals = x.Sheets("Sheet1").Range("G8").Value

y.Sheets("Sheet1").Range("G8").Value = vals


x.Close

End Sub

标签: excelvba

解决方案


请尝试下一个代码。它应该非常快,使用数组并且只在内存中工作。基本上,它复制了讨论中的范围,它是连续的并粘贴了反转的数组:

Sub testCopyReversedRange()
 Dim x As Workbook, y As Workbook, sh As Worksheet, ws As Worksheet
 Dim arr As Variant, arrFin As Variant, i As Long, k As Long

 Set y = ActiveWorkbook: Set sh = y.Sheets("Sheet1")
 Set x = Workbooks.Open("C:\x\xx\xx\Folder\File.xls")
 Set ws = x.Sheets("Sheet1")

 arr = sh.Range("C8:G8").Value
 ReDim arrFin(UBound(arr, 1) To UBound(arr, 2), 1 To 1)
    
 For i = UBound(arr, 2) To 1 Step -1 'reverse the array order and transpose it
    k = k + 1
    arrFin(k, 1) = arr(1, i)
 Next i
 ws.Range("G8").Resize(UBound(arrFin, 1), UBound(arrFin, 2)).Value = arrFin
End Sub

编辑:

还有一个更紧凑的版本:

Sub testCopyReversedRangeBis()
 Dim x As Workbook, y As Workbook, sh As Worksheet, ws As Worksheet
 Dim arr As Variant, arrFin As Variant, I As Long, k As Long, vals As Variant

 Set y = ActiveWorkbook: Set sh = y.Sheets("Sheet1")
 Set x = Workbooks.Open("C:\x\xx\xx\Folder\File.xls")
 Set ws = x.Sheets("Sheet1")
 arr = sh.Range("C8:G8").Value
 arrFin = Split(StrReverse(Join(Application.Index(arr, 1, 0), ",")), ",")

 ws.Range("G8").Resize(UBound(arrFin) + 1, 1).Value = WorksheetFunction.Transpose(arrFin)
End Sub

推荐阅读