将特定单元格从已关闭的工作簿复制到我的 ActiveWorkbook

Question

我希望打开一个已关闭的工作簿，按顺序将单元格 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

Answer 1

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

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

Answer 2

您可以通过阅读 cmets 并对其进行调整以适应您的需要来自定义此代码：

Public Sub CopyCells()
    
    Dim sourceWorkbook As Workbook
    Dim sourceWorkbookPath As String
    
    Dim targetWorkbook As Workbook
    Dim counter As Long
    
    
    sourceWorkbookPath = "C:\x\xx\xx\Folder\File.xls"
    Set sourceWorkbook = Workbooks.Open(sourceWorkbookPath)
    
    Set targetWorkbook = ActiveWorkbook
    
    ' Dimension the array to the number of cells you're gonna copy
    Dim cellsToCopyConfig(4) As Variant
    
    ' Define the (source sheet and cell) and the (target sheet and cell)
    cellsToCopyConfig(0) = Array("Sheet1", "G8", "Sheet1", "G8")
    cellsToCopyConfig(1) = Array("Sheet1", "F8", "Sheet1", "G9")
    cellsToCopyConfig(2) = Array("Sheet1", "E8", "Sheet1", "G10")
    cellsToCopyConfig(3) = Array("Sheet1", "D8", "Sheet1", "G11")
    cellsToCopyConfig(4) = Array("Sheet1", "C8", "Sheet1", "G12")
    
    
    For counter = 0 To UBound(cellsToCopyConfig)
    
        sourceWorkbook.Sheets(cellsToCopyConfig(counter)(0)).Range(cellsToCopyConfig(counter)(1)).Copy _
            targetWorkbook.Sheets(cellsToCopyConfig(counter)(2)).Range(cellsToCopyConfig(counter)(3))
    
    Next counter
    
    sourceWorkbook.Close

End Sub

让我知道它是否有效

Answer 3

您将不惜一切代价避免select。可能有更有效的方法来解决这个问题，但这是一个非常简单的方法，您可以遵循

Dim new_wb as Workbook, old_wb as Workbook
Dim new_ws as Worksheet, old_ws as Worksheet
Dim i as Long
Dim new_Cells as Variant, old_Cells as Variant

'set where you want the cells to go in the new workbook
new_Cells = Array("G8", "G9", "G10", "G11", "G12")

'now set where the old cells you want to match up are
old_Cells = Array ("G8, "F8, "E8", "D8", "C8")

'set your active workbook first, that way your computer doesn't confuse the one you will open soon
Set new_wb = ActiveWorkbook
Set new_ws = new_wb.Sheets("Sheet1")

'now open and set your other workbook
Set old_wb = Workbooks.Open('yourpath')
Set old_ws = old_wb.Sheets("Sheet1")

'Loop through where you want the new cells, and put the old cells in that spot. Notice we change the array we use between the new workbook and the old one
For i = LBound(new_Cells) to UBound(new_Cells)
    new_ws.Range(new_Cells(i)).value = old_ws.Range(old_Cells(i)).value
Next i

old_wb.Close

End Sub

Answer 4

1. 如果只有 5 个单元格，我几乎看不出有任何理由使用表格、循环等。
2. 目标单元格构成一个连续范围，因此如果您决定使用循环，则无需准备包含范围的数组，最好将循环索引放入偏移量或使用表格作为值，完成后复制目标范围内的内容。

Answer 5

从已关闭的工作簿中读取数据而不打开它们的几种方法之一是使用 ExecuteExcel4Macro 函数：

• 您需要使用 R1C1 参考样式
• 您无法利用 UsedRange 及其所有优势，因为您只能单独评估每个单元格
• 用撇号封装的文件和工作表名称
• 用括号括起来的实际工作簿名称
• 然后，使用“！”表示外部参考

知道工作簿和工作表名称后，您可以按如下方式进行设置（已测试且有效！）：

ExecuteExcel4Macro("'C:\Users\SomeUser\Documents\[test read.xlsb]Sheet1'!R1C1")

Answer 6

为了避免打开工作簿，您可以试试这个

Sub UpdateData()
    Dim cl As Range
    With ThisWorkbook.Sheets("Sheet1").Range("G8:G12")
        For Each cl In .Cells
            cl.Formula = "='C:\x\xx\xx\Folder\[File.xls]Sheet1'!" & Chr(79 - cl.Row) & "8"
        Next cl
        .Value = .Value
    End With
End Sub

这需要 0.14 秒才能在我的计算机上运行。

编辑：（跟随 cmets）

Chr(71) = "G"
Chr(70) = "F"
Chr(69) = "E"
Chr(68) = "D"
Chr(67) = "C"

So you need to map
Row ->  Letter ascii Code ->   Chr(79 - cl.Row) & "8"
8   ->  71 = 79 - 8       ->   G8
9   ->  70 = 79 - 9       ->   F8
10  ->  69 = 79 - 10      ->   E8
11  ->  68 = 79 - 11      ->   D8
12  ->  67 = 79 - 12      ->   C8

Hope this clarifies the formula