Subscript out of range trying to copy a range in Excel

0
votes

I'm trying to do something pretty simple in Excel - just prompt for a filename, copy the contents (keeping the formatting) of a worksheet in that file into a sheet with the same name in the currently open workbook. I keep getting "Subscript out of range" on the line "Workbooks(oldfname).Sheets("Player List").Range("A1:Z100").Copy". Here's the code:

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

Any help would be appreciated, thanks!

2
excelvba

2 Answers

0
votes

I'm pretty sure it's because your oldfname will return a string with a path in it. You just want the workbook name.

Thanks to @Gonzalo for this script that will trim that down. Also, I tried to trim/clarify your macro. Does Application.GetOpenFileName actually open the file, or are you just getting the name? I'm assuming the latter.

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

Then, also add this Function:

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://stackguides.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

I may have the sheets wrong in the original, but that should be an easy fix for you.

0
votes

After further investigation, I discovered the root cause of the "subscript out of range" error was that the source file has to be open before you can copy info out of it. Duh. So here's my final code, which works fine. 

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