在 VBA 中导入工作表时出错

Question

我正在尝试编写一个 VBA 宏来从另一个工作簿导入工作表。我在“复制”行收到“下标超出范围”错误。文件可以正确打开，但我不确定之后出了什么问题。

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim lastdate As String, filename As String

lastdate = Format(sheet_1.Range("D11") - 7, "ddmmyy")
filename = "C:\Dir\file " & lastdate & ".xlsm"

Workbooks.Open (filename)
Workbooks(filename).Worksheets(2).Copy after:=ThisWorkbook.Worksheets(1)

Workbooks(filename).Close

Application.ScreenUpdating = True
Application.DisplayAlerts = False

End Sub

编辑：错误更改为“下标超出范围”，代码已更改，因此索引引用了工作表。

代码 v2：

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim lastdate As String, filename As String

lastdate = Format(sheet1.Range("D11") - 7, "ddmmyy")
filename = "C:\Dir\file " & lastdate & ".xlsm"

Dim wbk As Workbook
wbk = Workbooks.Open(filename)

wbk.Worksheets(2).Copy after:=ThisWorkbook.Worksheets(1)
wbk.Close

End Sub

Answer 1

您收到下标超出范围错误，因为您没有工作簿的 Name 权限。 Name 与完整路径不同（这是您一直在假设的）；它与文件名相同。

这将起作用：

Workbooks.Open "C:\Dir\file1234.xlsm"
Workbooks("file1234.xlsm").Sheets(1).Range("a1").Value = "yay"

而这不会：

Workbooks.Open "C:\Dir\file1234.xlsm"
Workbooks("C:\Dir\file1234.xlsm").Sheets(1).Range("a1").Value = "yay"

但是引用工作簿的更好方法是像这样设置对它的显式引用：

Dim wbk As Workbook
Set wbk = Workbooks.Open(filename)
wbk.Worksheets(2).Copy after:=ThisWorkbook.Worksheets(1)

使用wbk，您现在可以处理您想要的工作簿；你不必猜测它的名字或任何东西。

Answer 2

引用对象变量时需要关键字“Set”：

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
'Application.DisplayAlerts = False '<<this does not look like it is required - when is an alert displayed in the method?

Dim lastdate As String, filename As String

lastdate = Format(sheet1.Range("D11") - 7, "ddmmyy")
filename = "C:\Dir\file " & lastdate & ".xlsm"

Dim wbk As Workbook
Set wbk = Workbooks.Open(filename)   '<<Set is required

wbk.Worksheets(2).Copy after:=ThisWorkbook.Worksheets(1)
wbk.Close

End Sub

Answer 3

Option Explicit

Sub Import_Worksheets()

Dim FolderPath As String
Dim Filename As String
Dim sheet As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

FolderPath = "H:G:\D S Class\Excel VBA (Macro)\RTO form\VBA\"
Filename = Dir(FolderPath & "RESTAURANT_USAGE_DATA.xlsx")

Do While Filename <> ""
 Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
 For Each sheet In ActiveWorkbook.Sheets
 sheet.Copy After:=ThisWorkbook.Sheets(1)
 Next sheet
 Workbooks(Filename).Close
 Filename = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

    enter code here