VBA excel 打开文件并复制工作表错误下标超出范围

Question

我正在尝试将另一个 excel 文件中的工作表复制到其中一个工作表，但出现下标超出范围错误。 错误来自这一行，'.Worksheets(1).UsedRange.Copy ThisWorkbook.Worksheets("Sheet1").Range("A1")'。

Dim FileToOpen As Variant
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Excel File to Open", _
FileFilter:="Excel Files *.xlsx(*.xlsx),")
If VarType(FileToOpen) = vbBoolean Then
   MsgBox "No file selected", vbExclamation, "Sorry!"
    Exit Sub
End If
Debug.Assert VarType(FileToOpen) = vbString
With Application.Workbooks.Open(FileToOpen)
  .Worksheets(1).UsedRange.Copy ThisWorkbook.Worksheets("Sheet1").Range("A1")
  .Close
End With

Answer 1

试试下面

Dim FileToOpen As Variant
dim tempFile as workbook
dim tempWs as worksheet
dim thisWs as worksheet

Application.ScreenUpdating = False
set thisWs = ThisWorkbook.Worksheets("Sheet1")

FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Excel File to Open", _
FileFilter:="Excel Files *.xlsx(*.xlsx),")
If VarType(FileToOpen) = vbBoolean Then
   MsgBox "No file selected", vbExclamation, "Sorry!"
   Exit Sub
End If
Debug.Assert VarType(FileToOpen) = vbString
set tempFile =Workbooks.Open(FileToOpen)
set tempWs  = tempFile.worksheets(1)

tempWs  .cells.Copy thisWs.Range("A1")
tempFile .close 

set tempFile = nothing
set tempWs  = nothing

Application.ScreenUpdating = true