Question

我正在尝试在Excel中执行一些非常简单的操作 - 只需提示输入文件名，将该文件中工作表的内容（保持格式）复制到当前打开的工作簿中具有相同名称的工作表中。我继续在“工作簿（oldfname）.Sheets（”播放器列表“）的范围内获得”下标超出范围“。范围（”A1：Z100“）。复制”。这是代码：

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

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

Answer 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

我的原件可能有错误，但这应该是一个很容易解决的问题。

Answer 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

下标超出范围试图在Excel中复制范围

2 个答案: