Excel VBA Copy and Paste Code Error

[mkenny]

Hi

I'm trying to write a code that will copy data from one workbook and paste it to another. I'm inexperienced with coding, so I copied a code I found online. I tired to add some lines that would allow the user to choose any workbook to copy from. Once I added these lines I got this error message "Run-time error '9': Subscript out of range."

The code was working fine before I added new lines. Below is the code I have been working on. I have "ERROR" behind the line that the debugger highlights

Sub CopyDataFileGrab()

Dim sBook_t As String
Dim sBook_s As String


Dim sSheet_t As String
Dim sSheet_s As String


Dim lMaxRows_t As Long
Dim lMaxRows_s As Long


Dim sMaxCol_s As String


Dim sRange_t As String
Dim sRange_s As String


    sBook_t = "Target Data WB- Copy data to WB.xlsm"
       
    sSheet_t = "Target WB"
    sSheet_s = "Source"
       
    LResponse = MsgBox("Would like to delete current data and replace it with data from another file.  Do you wish to continue?", vbYesNo, "Continue")
 If LResponse = vbYes Then
 
    Set myFile = Application.FileDialog(msoFileDialogOpen)
    With myFile
     .Title = "Select the File to be imported:"
     .AllowMultiSelect = False
     If .Show <> -1 Then
        Exit Sub
     End If
     
     
     sBook_s = .SelectedItems(1)
     
     Workbooks.Open Filename:=sBook_s
     
     'Finds the maximum rows from the target and source workbook
    lMaxRows_t = Workbooks(sBook_t).Sheets(sSheet_t).Cells(Rows.Count, "A").End(xlUp).Row
    lMaxRows_s = Workbooks(sBook_s).Sheets(sSheet_s).Cells(Rows.Count, "A").End(xlUp).Row 'ERROR!!!!!
       
    'Finds the maximum columns in the source workbook only
    sMaxCol_s = Workbooks(sBook_s).Sheets(sSheet_s).Cells(1, Columns.Count).End(xlToLeft).Address
    sMaxCol_s = Mid(sMaxCol_s, 2, InStr(2, sMaxCol_s, "$") - 2)
       
    'If (lMaxRows_t = 1) Then
     '   sRange_t = "A1:" & sMaxCol_s & lMaxRows_s
      '  sRange_s = "A1:" & sMaxCol_s & lMaxRows_s
           
       ' Workbooks(sBook_t).Sheets(sSheet_t).Range(sRange_t) = Workbooks(sBook_s).Sheets(sSheet_s).Range(sRange_s).Value
               
    'Else
        sRange_t = "A" & (lMaxRows_t + 1) & ":" & sMaxCol_s & (lMaxRows_t + lMaxRows_s - 1)
        sRange_s = "A2:" & sMaxCol_s & lMaxRows_s
           
        Workbooks(sBook_t).Sheets(sSheet_t).Range(sRange_t) = Workbooks(sBook_s).Sheets(sSheet_s).Range(sRange_s).Value
     
    End With
     
    If sBook_s = "" Then
          MsgBox "No file was selected.", vbOK, "No Selection"
          Exit Sub
    End If
    
End If
             
End Sub

Any help on this would be greatly appreciated!

Thank you

 

[ismii]

How about instead of storing the name of the workbook, you use the workbooks as objects?

The error is happening because when you get the book it is the entire string of the location, not just the workbook name.

You could try (adding this snippet):

     Workbooks.Open Filename:=sBook_s 'This is your line, the rest is added
     Dim strSplit() As String
     strSplit = Split(sBook_s, "\")
     sBook_s = strSplit(UBound(strSplit))

This will make sure that when we reference the workbook, we are only going to be referencing the name rather than the location.

 

[mkenny]

Thanks so much! This worked perfectly!