下标超出范围尝试在 Excel 中复制范围答案

【问题标题】：Subscript out of range trying to copy a range in Excel下标超出范围尝试在 Excel 中复制范围
【发布时间】：2016-07-05 13:23:45
【问题描述】：

我正在尝试在 Excel 中做一些非常简单的事情 - 只需提示输入文件名，将该文件中工作表的内容（保留格式）复制到当前打开的工作簿中具有相同名称的工作表中。我在“Workbooks(oldfname).Sheets("Player List").Range("A1:Z100").Copy" 行中不断收到“下标超出范围”。代码如下：

Private Sub CopyPlayerInfoButton_Click()

Dim fnameWithPath, oldfname  As String

oldfname = Application.GetOpenFilename(, , "Old ePonger file")

Sheets("Player List").Visible = True
Sheets("Player List").Activate
Application.CutCopyMode = False

Workbooks(oldfname).Sheets("Player List").Range("A1:Z100").Copy
Range("A1:Z100").Select
ActiveSheet.Paste

End Sub

任何帮助将不胜感激，谢谢！

【问题讨论】：

标签： excel vba

【解决方案1】：

我很确定这是因为您的oldfname 将返回一个带有路径的字符串。您只需要工作簿名称。

感谢@Gonzalo 提供的脚本，它可以减少它。另外，我试图修剪/澄清你的宏。 Application.GetOpenFileName 是否真的打开了文件，或者你只是得到了名字？我假设是后者。

Private Sub CopyPlayerInfoButton_Click()

Dim fnameWithPath, oldfname  As String
Dim activeWS As Worksheet, activeWB As Workbook
Application.CutCopyMode = False

Set activeWB = ActiveWorkbook
Set activeWS = ActiveSheet

oldfname = Application.GetOpenFilename(, , "Old ePonger file")
oldfname = GetFilenameFromPath(oldfname)


activeWB.Sheets("Player List").Visible = True
activeWB.Sheets("Player List").Activate ' Why activate this?

Workbooks(oldfname).Sheets("Player List").Range("A1:Z100").Copy
activeWB.Sheets("Player List").Range("A1:Z100").Paste

End Sub

然后，还要添加这个函数：

Function GetFilenameFromPath(ByVal strPath As String) As String
' Returns the rightmost characters of a string upto but not including the rightmost '\'
' e.g. 'c:\winnt\win.ini' returns 'win.ini'
' by @Gonzalo, https://stackoverflow.com/questions/1743328/how-to-extract-file-name-from-path

    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

我可能在原版中的表格有误，但这对你来说应该很容易解决。

【讨论】：

谢谢布鲁斯。我复制了这两个函数并尝试运行它，现在我在 activeWB.Sheets("Player List").Range("A1:Z100") 行处收到运行时错误 438“对象不支持此属性或方法” .粘贴
好的，我将该行更改为 activeWB.Sheets("Player List").Range("A1:Z100").PasteSpecial xlPasteAll 并且它工作正常。再次感谢布鲁斯！！！

【解决方案2】：

经过进一步调查，我发现“下标超出范围”错误的根本原因是必须打开源文件才能从中复制信息。呃。所以这是我的最终代码，它工作正常。

Private Sub CopyPlayerInfoButton_Click()

Dim fnameWithPath, oldfname, oldfname2  As String
Dim activeWS As Worksheet, activeWB As Workbook

Application.CutCopyMode = False

On Error GoTo errorhandling

Set activeWB = ActiveWorkbook
Set activeWS = ActiveSheet

oldfname = Application.GetOpenFilename(, , "Old ePonger file")
oldfname2 = GetFilenameFromPath(oldfname)

Workbooks.Open (oldfname)

activeWB.Sheets("Player List").Visible = True
activeWB.Sheets("Player List").Activate

Workbooks(oldfname2).Sheets("Player List").Range("A1").Copy
activeWB.Sheets("Player List").Range("A1").PasteSpecial xlPasteAll  'copy the entire sheet


MsgBox ("All your data has been copied from " & oldfname & " to this current version of ePonger.")

Unload Me
Exit Sub

errorhandling:
  MsgBox ("Error in CopyPlayerInfoButton, could not copy player info from old ePonger file " & oldfname & ".  Make sure this file is open.  Also, you may have selected a file that's corrupt or isn't a valid ePonger file.  Please try again.")

End Sub

【讨论】：