Grab a sheet from another workbook

[drop05]

I am trying to add to my code where the user can select a file and then find the tab i have listed below and have it brought over into the workbook the code lives in because id put it into a button

Sub Copy_Sheets()


Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

Dim filePicker As FileDialog
Dim path As String

Set filePicker = Application.FileDialog(msoFileDialogFilePicker)
    With filePicker
    .Title = "Please select File"
    .AllowMultiSelect = False
    .ButtonName = "Confirm"
        If .Show = -1 Then
            path = .SelectedItems(1)
        Else
            End
        End If
    End With


'Dim target As ActiveWorkbook

Dim sourceWS As Worksheet
Set sourceWS = Worksheet

Dim Worksheets As Variant
ReDim Worksheets(1)

Worksheets(1) = "GatheredName"

Dim i As Variant
For i = 1 To UBound(Worksheets)
    Workbooks(Source).Sheets(Worksheets(i)).Copy _
        After:=Workbooks(Destination).Sheets(Workbooks(Destination).Sheets.Count)
Next i

End Sub

 

[HaHoBe]

Hi drop05,

what about this code for a start:

Sub MrE1611610()
'https://www.mrexcel.com/board/threads/grab-a-sheet-from-another-workbook.1218374/

  Dim wbkThis           As Workbook
  Dim objFilePicker     As FileDialog
  Dim strPath           As String
  Dim wbkToOpen         As Workbook
  Dim wksWanted         As Worksheet

  Set wbkThis = ThisWorkbook
  Set objFilePicker = Application.FileDialog(msoFileDialogFilePicker)
  With objFilePicker
    .Title = "Please select File"
    .AllowMultiSelect = False
    .ButtonName = "Confirm"
      If .Show = -1 Then
        strPath = .SelectedItems(1)
      Else
        GoTo clear_up
      End If
  End With
  
  '/// assuming workbook is closed. If already open, loop through available workbooks
  Set wbkToOpen = Workbooks.Open(strPath)
  
  On Error Resume Next
  Set wksWanted = wbkToOpen.Worksheets("GatheredName")
  On Error GoTo 0
  If wksWanted Is Nothing Then
    MsgBox "Worksheet to copy not found in workbook '" & strPath & "'. Closing macro.", _
              vbInformation, "Copying not possible"
    GoTo clear_up
  End If

  wksWanted.Copy after:=wbkThis.Worksheets(wbkThis.Worksheets.Count)

clear_up:
  On Error Resume Next
  wbkToOpen.Close savechanges:=False
  Set wksWanted = Nothing
  Set wbkToOpen = Nothing
  Set objFilePicker = Nothing
  Set wbkThis = Nothing
End Sub

Ciao,
Holger