错误：运行时错误9下标超出范围：为数据复制分配工作表variables

虽然这是常见的错误，我试图find相关的主题，但没有学会修复我的代码。 我试图复制某些特定供应商的Excel工作表的单元格，当我们从他们那里收到更新，以避免手动复制。 我看到这个错误

Set Source = Workbooks(strFileName).Worksheets("Demand Request Details") 

步。 请帮忙。

 Sub MergeInflight01() Dim j As Long Dim i As Long Dim Ret Dim wbk As Workbook Dim numofrows As Long Dim strFileName As String Dim strVendorName As String Dim Source As Worksheet, Destination As Worksheet Dim arrA(1 To 15, 1 To 2) As Variant Sheets("Demand Request Details").Select strFileName = InputBox("Please Enter the source file with Path to take data from") strVendorName = InputBox("Please Enter the Vendor name from XYZ") If FileInUse(strFileName) Then ' Open the work-book if not opened already Set wkbSource = Workbooks.Open(strFileName) End If 'ERROR HERE Set Source = Workbooks(strFileName).Worksheets("Demand Request Details") numofrows = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row + 5 strFileName = InputBox("Please Enter the Destination file with Path to take data from") If FileInUse(strFileName) Then ' Open the work-book if not opened already Set wkbSource = Workbooks.Open(strFileName) End If Set Destination = Workbooks(strFileName).Worksheets("Demand Request Details") For i = 1 To numofrows If (Source.Cells(i, 22).Value = "DELIVERY") And (Source.Cells(i, 14).Value = strVendorName) Then For j = 1 To numofrows If (Source.Cells(i, 1).Value = Destination.Cells(j, 1).Value) And (Source.Cells(i, 6).Value = Destination.Cells(j, 6).Value) Then Source.Cells(i, 20).Value = Destination.Cells(j, 20).Value Source.Cells(i, 38).Value = Destination.Cells(j, 38).Value Source.Cells(i, 39).Value = Destination.Cells(j, 39).Value Source.Cells(i, 40).Value = Destination.Cells(j, 40).Value Source.Cells(i, 41).Value = Destination.Cells(j, 41).Value Source.Cells(i, 42).Value = Destination.Cells(j, 42).Value ElseIf (Source.Cells(i, 1).Value = Destination.Cells(j, 1).Value) And (Source.Cells(i, 6).Value <> Destination.Cells(j, 6).Value) Then Source.Cells(i, 1).Interior.ColorIndex = 3 End If Next j End If Next i End Sub Public Function FileInUse(sFileName) As Boolean On Error Resume Next Open sFileName For Binary Access Read Lock Read As #1 Close #1 FileInUse = IIf(Err.Number > 0, True, False) On Error GoTo 0 End Function 

Answer 1

而不是使用input框来input文件名和path，请使用Application.GetOpenFilename

您还需要从完整path中提取文件名，以便您可以使用已打开的工作簿。

这是你正在尝试？

 Sub MergeInflight01() Dim wkbSource As Workbook Dim Filetoopen Dim WBName As String '~~> Let user select the file Filetoopen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*") If Filetoopen <> False Then WBName = GetFilenameFromPath(Filetoopen) If IsWorkBookOpen(WBName) Then Set wkbSource = Workbooks(WBName).Worksheets("Demand Request Details") Else Set wkbSource = Workbooks.Open(Filetoopen) End If ' '~~> Rest of the code ' End If End Sub '~~> Check if the Workbook is open Function IsWorkBookOpen(FileName) Dim ff As Long, ErrNo As Long On Error Resume Next ff = FreeFile() Open FileName For Input Lock Read As #ff Close ff ErrNo = Err On Error GoTo 0 Select Case ErrNo Case 0: IsWorkBookOpen = False Case 70: IsWorkBookOpen = True Case Else: Error ErrNo End Select End Function '~~> Get filename from path Public Function GetFilenameFromPath(ByVal strPath As String) As String If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then GetFilenameFromPath = _ GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1) End If End Function