VBA - Import Workbook/Choose Sheet/Display Details

D

default_name

Board Regular
Joined
May 16, 2018
Messages
170
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
  2. MacOS
Hello,

This was a follow-on question related to another thread here on the board.
At the recommendation of the board (the original question is more than 1400 days old), as well as the original solution giver, I am posting this with some of my own directed details.

I am trying to do a mixture of a few different things I have found on this board, but I have had difficulty implementing it.
Source posts:
VBA Code to Select Import Worksheet from a Workbook
Macro to Open File Select a Sheet and Copy This to Another File

I have two worksheets in my workbook ('Status' and 'Import').
On sheet 'Status' I have a button that is attached to a macro called 'ImportData'.

  1. When the button is pressed, I want the user to be prompted to select an excel workbook.
  2. Since the possible workbooks to choose from are all unique in names and content, once a file is selected, I want the user to then be able to identify which worksheet within the desired workbook they would like to import.
    (I found a macro that seemed to accomplish this task quite nicely, but it only works if the desired file is already open.)
  3. The desired worksheet is then copied from the chosen workbook, onto my 'Import' tab/worksheet
  4. The location of the file is displayed/pasted on cell B6 of the 'Status' worksheet/tab

Here is what I currently have. I feel like I am so close, but there are some snags that I have been unable to overcome on my own.
I added some notes/comments, to hopefully help.

VBA Code: 
Sub ImportData()
    Dim OpenBook As Workbook
    Dim TargetFile As String

    'Need code here that prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
  
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
    Dim msg As String
    msg = "Which worksheet would you like to copy from this file?"
  
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & "(" & i & ") " & .Worksheets(i).Name & vbCrLf
        Next i
  
        response = InputBox(msg, "Type numbers for sheets to import")
  
        If response = Null Then Exit Sub 'check for cancel button
  
        For x = .Worksheets.Count To 1 Step -1
            If InStr(response, x) > 0 Then
                Dim ws As Worksheet
                Set ws = .Worksheets(x)
                ws.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                ActiveSheet.Name = "Import"
            End If
        Next x
    End With
        Sheets("Status").Select    'This routine pastes the path of the chosen/selected file on cell B6 of the 'Status' tab/sheet
        Range("B" & counter + 6).Value = TargetFile
  
    If FileName <> False Then
    End If
  
    'Need code here that closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = False
  
End Sub

I hope this was clear enough. If not, let me know.
Thanks in advance for your help!
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Sort by date Sort by votes
Hi default_name,

I must say some of the above code was confusing to me but see how this revamped version goes:

VBA Code: 
Option Explicit
Sub ImportData()
    
    Dim OpenBook As Workbook
    Dim TargetFile As String, msg As String, FileName As String, response As String
    Dim lngCount As Long, i As Long, x As Long, counter As Long
    Dim ws As Worksheet

    'Need code here that prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
    
   ' Open the file dialog
    With Application.FileDialog(3) '3 = msoFileDialogOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                Set OpenBook = Workbooks.Open(CStr(.SelectedItems(lngCount))) 'Assumes the workbook is not already open
                TargetFile = Dir(CStr(.SelectedItems(lngCount))) 'Not really sure why this is needed as the OpenBook variable suffices.
            Next lngCount
        Else
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = False
  
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
    
    msg = "Which worksheet would you like to copy from """ & TargetFile & """?"
  
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & vbCrLf & "(" & i & ") " & .Worksheets(i).Name
        Next i
        
        response = InputBox(msg, "Type numbers for sheets to import")
  
        If response = "" Then Exit Sub 'check for cancel button
        
        On Error Resume Next
            Set ws = .Worksheets(CLng(response))
            If Err.Number = 0 Then
                ws.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import"   'Name will not change if a tab called 'Import' already exists???
            End If
        On Error GoTo 0
    End With
    'Sheets("Status").Select    'This routine pastes the path of the chosen/selected file on cell B6 of the 'Status' tab/sheet
    'Range("B" & counter + 6).Value = TargetFile
    ThisWorkbook.Sheets("Status").Range("B6").Value = TargetFile
  
    'If FileName <> False Then
    'End If
  
    'Need code here that closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = True
  
End Sub

Regards,

Robert
 
Upvote 0
Trebor76 said:
Hi default_name,

I must say some of the above code was confusing to me but see how this revamped version goes:

VBA Code: 
Option Explicit
Sub ImportData()
   
    Dim OpenBook As Workbook
    Dim TargetFile As String, msg As String, FileName As String, response As String
    Dim lngCount As Long, i As Long, x As Long, counter As Long
    Dim ws As Worksheet

    'Need code here that prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
   
   ' Open the file dialog
    With Application.FileDialog(3) '3 = msoFileDialogOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                Set OpenBook = Workbooks.Open(CStr(.SelectedItems(lngCount))) 'Assumes the workbook is not already open
                TargetFile = Dir(CStr(.SelectedItems(lngCount))) 'Not really sure why this is needed as the OpenBook variable suffices.
            Next lngCount
        Else
            Exit Sub
        End If
    End With
   
    Application.ScreenUpdating = False
 
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
   
    msg = "Which worksheet would you like to copy from """ & TargetFile & """?"
 
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & vbCrLf & "(" & i & ") " & .Worksheets(i).Name
        Next i
       
        response = InputBox(msg, "Type numbers for sheets to import")
 
        If response = "" Then Exit Sub 'check for cancel button
       
        On Error Resume Next
            Set ws = .Worksheets(CLng(response))
            If Err.Number = 0 Then
                ws.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import"   'Name will not change if a tab called 'Import' already exists???
            End If
        On Error GoTo 0
    End With
    'Sheets("Status").Select    'This routine pastes the path of the chosen/selected file on cell B6 of the 'Status' tab/sheet
    'Range("B" & counter + 6).Value = TargetFile
    ThisWorkbook.Sheets("Status").Range("B6").Value = TargetFile
 
    'If FileName <> False Then
    'End If
 
    'Need code here that closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = True
 
End Sub

Regards,

Robert
Click to expand...
You are awesome, Robert!
It works great!

I do see the dilemma (commented in your solution), regarding the Import tab. If the tab already exists, then the code simply imports the incoming data as the worksheet was originally titled.
Is there a way to have the information be copied into the existing 'Import' tab?
 
Upvote 0
You are awesome, Robert!
Click to expand...
You obviously don't know me very well :)

Try this where the Import sheet is deleted if it exists and then the selected tab is imported. I have also included an error trap if an user incorrectly enters a number that does correlate with a worksheet in the workbook that has the tab to be imported i.e. there are 5 sheets but the user entered 6 (this is why a form with a list box of each sheet name that the user selects that I mentioned in my other post would have been a better option):

VBA Code: 
Option Explicit
Sub ImportData()
    
    Dim OpenBook As Workbook
    Dim TargetFile As String, msg As String, FileName As String, response As String
    Dim lngCount As Long, i As Long, x As Long, lngLastRow As Long
    Dim wsFrom As Worksheet, wsTo As Worksheet

    'Need code here that prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
    
   ' Open the file dialog
    With Application.FileDialog(3) '3 = msoFileDialogOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                Set OpenBook = Workbooks.Open(CStr(.SelectedItems(lngCount))) 'Assumes the workbook is not already open
                TargetFile = Dir(CStr(.SelectedItems(lngCount))) 'Not really sure why this is needed as the OpenBook variable suffices.
            Next lngCount
        Else
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = False
  
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
    
    msg = "Which worksheet would you like to copy from """ & TargetFile & """?"
  
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & vbCrLf & "(" & i & ") " & .Worksheets(i).Name
        Next i
SheetSelector:
        response = InputBox(msg, "Type numbers for sheets to import")
        If response = "" Then Exit Sub 'check for cancel button
        On Error Resume Next
            'Error trap if user has entered a number that is incorrect
            Set wsFrom = .Worksheets(CLng(response))
            If Err.Number <> 0 Then
                If MsgBox("There is no worksheet number " & response & " in """ & TargetFile & """." & vbNewLine & "Try again?", vbQuestion + vbYesNo) = vbYes Then
                    GoTo SheetSelector
                    On Error GoTo 0
                Else
                    Exit Sub
                End If
            End If
            'Import worksheet selection to a sheet 'Import'
            Set wsTo = ThisWorkbook.Worksheets("Import")
                If Err.Number <> 0 Then
                    wsFrom.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import"
                Else
                    'If 'Import' exists, then...
                    Application.DisplayAlerts = False
                        '...delete it as this avoids conflicts with named ranges
                        wsTo.Delete
                    Application.DisplayAlerts = True
                    wsFrom.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import"
                End If
        On Error GoTo 0
        
    End With
    
    ThisWorkbook.Sheets("Status").Range("B6").Value = TargetFile 'This routine pastes the path of the chosen/selected file on cell B6 of the 'Status' tab/sheet
    
    'Need code here that closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = True
  
End Sub

Regards,

Robert
 
Upvote 0
Trebor76 said:
You obviously don't know me very well :)

Try this where the Import sheet is deleted if it exists and then the selected tab is imported. I have also included an error trap if an user incorrectly enters a number that does correlate with a worksheet in the workbook that has the tab to be imported i.e. there are 5 sheets but the user entered 6 (this is why a form with a list box of each sheet name that the user selects that I mentioned in my other post would have been a better option):

VBA Code: 
Option Explicit
Sub ImportData()
   
    Dim OpenBook As Workbook
    Dim TargetFile As String, msg As String, FileName As String, response As String
    Dim lngCount As Long, i As Long, x As Long, lngLastRow As Long
    Dim wsFrom As Worksheet, wsTo As Worksheet

    'Need code here that prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
   
   ' Open the file dialog
    With Application.FileDialog(3) '3 = msoFileDialogOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                Set OpenBook = Workbooks.Open(CStr(.SelectedItems(lngCount))) 'Assumes the workbook is not already open
                TargetFile = Dir(CStr(.SelectedItems(lngCount))) 'Not really sure why this is needed as the OpenBook variable suffices.
            Next lngCount
        Else
            Exit Sub
        End If
    End With
   
    Application.ScreenUpdating = False
 
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
   
    msg = "Which worksheet would you like to copy from """ & TargetFile & """?"
 
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & vbCrLf & "(" & i & ") " & .Worksheets(i).Name
        Next i
SheetSelector:
        response = InputBox(msg, "Type numbers for sheets to import")
        If response = "" Then Exit Sub 'check for cancel button
        On Error Resume Next
            'Error trap if user has entered a number that is incorrect
            Set wsFrom = .Worksheets(CLng(response))
            If Err.Number <> 0 Then
                If MsgBox("There is no worksheet number " & response & " in """ & TargetFile & """." & vbNewLine & "Try again?", vbQuestion + vbYesNo) = vbYes Then
                    GoTo SheetSelector
                    On Error GoTo 0
                Else
                    Exit Sub
                End If
            End If
            'Import worksheet selection to a sheet 'Import'
            Set wsTo = ThisWorkbook.Worksheets("Import")
                If Err.Number <> 0 Then
                    wsFrom.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import"
                Else
                    'If 'Import' exists, then...
                    Application.DisplayAlerts = False
                        '...delete it as this avoids conflicts with named ranges
                        wsTo.Delete
                    Application.DisplayAlerts = True
                    wsFrom.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import"
                End If
        On Error GoTo 0
       
    End With
   
    ThisWorkbook.Sheets("Status").Range("B6").Value = TargetFile 'This routine pastes the path of the chosen/selected file on cell B6 of the 'Status' tab/sheet
   
    'Need code here that closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = True
 
End Sub

Regards,

Robert
Click to expand...

Hi Trebor76,

Not that I'm trying to piggy back on this post, but I'm having difficulty with your code. I have updated the sheet name from "Import" to "Final" which is what I need but it doesn't actually copy the tab in for me.

I select the file location, I enter the number that correlates to the sheet I need, and then the opened sheet closes and nothing gets copied.

VBA Code: 
Sub ImportData()
    
    Dim OpenBook As Workbook
    Dim TargetFile As String, msg As String, FileName As String, response As String
    Dim lngCount As Long, i As Long, x As Long, lngLastRow As Long
    Dim wsFrom As Worksheet, wsTo As Worksheet

    'Need code here that prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
    
   ' Open the file dialog
    With Application.FileDialog(3) '3 = msoFileDialogOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                Set OpenBook = Workbooks.Open(CStr(.SelectedItems(lngCount))) 'Assumes the workbook is not already open
                TargetFile = Dir(CStr(.SelectedItems(lngCount))) 'Not really sure why this is needed as the OpenBook variable suffices.
            Next lngCount
        Else
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = False
  
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
    
    msg = "Which worksheet would you like to copy from """ & TargetFile & """?"
  
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & vbCrLf & "(" & i & ") " & .Worksheets(i).Name
        Next i
SheetSelector:
        response = InputBox(msg, "Type numbers for sheets to import")
        If response = "" Then Exit Sub 'check for cancel button
        On Error Resume Next
            'Error trap if user has entered a number that is incorrect
            Set wsFrom = .Worksheets(CLng(response))
            If Err.Number <> 0 Then
                If MsgBox("There is no worksheet number " & response & " in """ & TargetFile & """." & vbNewLine & "Try again?", vbQuestion + vbYesNo) = vbYes Then
                    GoTo SheetSelector
                    On Error GoTo 0
                Else
                    Exit Sub
                End If
            End If
            'Import worksheet selection to a sheet 'Final'
            Set wsTo = ThisWorkbook.Worksheets("Final")
                If Err.Number <> 0 Then
                    wsFrom.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Final' tab
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Final"
                Else
                    'If 'Final' exists, then...
                    Application.DisplayAlerts = False
                        '...delete it as this avoids conflicts with named ranges
                        wsTo.Delete
                    Application.DisplayAlerts = True
                    wsFrom.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Final' tab
                    ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Final"
                End If
        On Error GoTo 0
        
    End With
       
    'Need code here that closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = True
  
End Sub

Did I miss something?
 
Upvote 0
Hi larinda4,

Not sure as it works for me :confused: One possibility is that the workbook is protected which is stopping the data being imported.

Comment out this line of code...

VBA Code: 
On Error Resume Next

...and then run the macro to see what the issue is as this stops all error messages from appearing.

Robert
 
Upvote 0
Trebor76 said:
Hi larinda4,

Not sure as it works for me :confused: One possibility is that the workbook is protected which is stopping the data being imported.

Comment out this line of code...

VBA Code: 
On Error Resume Next

...and then run the macro to see what the issue is as this stops all error messages from appearing.

Robert
Click to expand...
Thanks Robert!

This is where I'm getting an error message "Run Time Error '9': Subscript out of range:

VBA Code: 
            Set wsTo = ThisWorkbook.Worksheets("Final")
 
Upvote 0
This is where I'm getting an error message "Run Time Error '9': Subscript out of range
Click to expand...

That error message appears when a tab being referenced does not exist. The above code should automatically create that tab so I don't think that's the issue.

Maybe uncomment the above line and then step through the code (by pressing F8 from anywhere within it) and track where it's failing that way. Did you ensure the workbook is not protected?
 
Upvote 0
Actually try this revised code:

VBA Code: 
Option Explicit
Sub ImportData()
 
    Dim OpenBook As Workbook
    Dim TargetFile As String, msg As String, FileName As String, response As String, strImportToTab As String
    Dim lngCount As Long, i As Long, x As Long, lngLastRow As Long
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim blnTabExists As Boolean

    'Need code here that prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
 
    strImportToTab = "Final" 'Tab name that the tab will be imported into. Change to suit if necessary.
 
   'Open the file dialog
    With Application.FileDialog(3) '3 = msoFileDialogOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                Set OpenBook = Workbooks.Open(CStr(.SelectedItems(lngCount))) 'Assumes the workbook is not already open
                TargetFile = Dir(CStr(.SelectedItems(lngCount))) 'Not really sure why this is needed as the OpenBook variable suffices.
            Next lngCount
        Else
            Exit Sub
        End If
    End With
 
    Application.ScreenUpdating = False
 
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
 
    msg = "Which worksheet would you like to copy from """ & TargetFile & """?"
 
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & vbCrLf & "(" & i & ") " & .Worksheets(i).Name
        Next i
SheetSelector:
        response = InputBox(msg, "Type numbers for sheets to import")
        If response = "" Then Exit Sub 'check for cancel button
        On Error Resume Next
            'Error trap if user has entered a number that is incorrect
            Set wsFrom = .Worksheets(CLng(response))
            If Err.Number <> 0 Then
                If MsgBox("There is no worksheet number " & response & " in """ & TargetFile & """." & vbNewLine & "Try again?", vbQuestion + vbYesNo) = vbYes Then
                    GoTo SheetSelector
                    On Error GoTo 0
                Else
                    Exit Sub
                End If
            End If
        On Error GoTo 0
        'Import worksheet selection to a sheet using the string variable 'strImportToTab'
        For Each wsTo In ThisWorkbook.Sheets
            If wsTo.Name = strImportToTab Then
                Exit For
            End If
        Next wsTo
        If wsTo Is Nothing Then
            OpenBook.Sheets(CStr(wsFrom.Name)).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = strImportToTab
        Else
            'If wsTo exists, then...
            Application.DisplayAlerts = False
                '...delete it as this avoids conflicts with named ranges
                wsTo.Delete
            Application.DisplayAlerts = True
            OpenBook.Sheets(CStr(wsFrom.Name)).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = strImportToTab
        End If
    End With
    
    'Need code here that closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = True
 
End Sub

Regards,

Robert
 
Last edited:
Upvote 0
Trebor76 said:
Actually try this revised code:

VBA Code: 
Option Explicit
Sub ImportData()
 
    Dim OpenBook As Workbook
    Dim TargetFile As String, msg As String, FileName As String, response As String, strImportToTab As String
    Dim lngCount As Long, i As Long, x As Long, lngLastRow As Long
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim blnTabExists As Boolean

    'Need code here that prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
 
    strImportToTab = "Final" 'Tab name that the tab will be imported into. Change to suit if necessary.
 
   'Open the file dialog
    With Application.FileDialog(3) '3 = msoFileDialogOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                Set OpenBook = Workbooks.Open(CStr(.SelectedItems(lngCount))) 'Assumes the workbook is not already open
                TargetFile = Dir(CStr(.SelectedItems(lngCount))) 'Not really sure why this is needed as the OpenBook variable suffices.
            Next lngCount
        Else
            Exit Sub
        End If
    End With
 
    Application.ScreenUpdating = False
 
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
 
    msg = "Which worksheet would you like to copy from """ & TargetFile & """?"
 
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & vbCrLf & "(" & i & ") " & .Worksheets(i).Name
        Next i
SheetSelector:
        response = InputBox(msg, "Type numbers for sheets to import")
        If response = "" Then Exit Sub 'check for cancel button
        On Error Resume Next
            'Error trap if user has entered a number that is incorrect
            Set wsFrom = .Worksheets(CLng(response))
            If Err.Number <> 0 Then
                If MsgBox("There is no worksheet number " & response & " in """ & TargetFile & """." & vbNewLine & "Try again?", vbQuestion + vbYesNo) = vbYes Then
                    GoTo SheetSelector
                    On Error GoTo 0
                Else
                    Exit Sub
                End If
            End If
        On Error GoTo 0
        'Import worksheet selection to a sheet using the string variable 'strImportToTab'
        For Each wsTo In ThisWorkbook.Sheets
            If wsTo.Name = strImportToTab Then
                Exit For
            End If
        Next wsTo
        If wsTo Is Nothing Then
            OpenBook.Sheets(CStr(wsFrom.Name)).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = strImportToTab
        Else
            'If wsTo exists, then...
            Application.DisplayAlerts = False
                '...delete it as this avoids conflicts with named ranges
                wsTo.Delete
            Application.DisplayAlerts = True
            OpenBook.Sheets(CStr(wsFrom.Name)).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = strImportToTab
        End If
    End With
   
    'Need code here that closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = True
 
End Sub

Regards,

Robert
Click to expand...
It worked! Thank you so much! You're a life saver.

I really appreciate it, Robert. Have an awesome day!
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Automatically import .txt files into separate sheets in Excel
Replies
1
Views
204
John_w
J
P
  • Solved
VBA to open file using Cell for the path
Replies
4
Views
608
Peter Davison
P
I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
267
Insurance Dave
I
GMC The Macro Man
  • Solved
VBA Script - Return to named file
Replies
6
Views
143
mumps
mumps
P
  • Question
VBA to import multilpe xml files
Replies
1
Views
57
PippaThePointer
P

Forum statistics

Threads
1,215,176
Messages
6,123,470
Members
449,100
Latest member
sktz

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top