Excel VBA- Importing specific sheets into a workbook from an external workbook - vba

Question

I was able to leverage someone else code to import a worksheet from an outside workbook, however the code requires me to manually change the worksheet name.
I currently have a column in workbook A that has the name of each (about 20) worksheet I am trying to pull from workbook B (which has hundreds of worksheets). Is there a way to loop this code and reference the column in workbook A to change the sheet name in my macro to be pulled from workbook B?
Code below (assuming WORKSHEET1 is the name of the worksheet I am pulling from workbook B)
Sub ImportSheet()
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile
Set wbBk = Workbooks(sFile)
With wbBk
If SheetExists("WORKSHEET1") Then
Set wsSht = .Sheets("WORKSHEET1")
wsSht.Copy before:=sThisBk.Sheets("Sheet1")
Else
MsgBox "There is no sheet with name :WORKSHEET1 in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function

Answer 1

Edited Try the following.
Sub ImportSheet()
Dim sImportFile As String, sFile As String
Dim wbThisWB As Workbook
Dim wbTheOtherWB As Workbook
Dim vfilename As Variant
Dim WSName As String
Dim LastRow As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbThisWB = ThisWorkbook
LastRow = wbThisWB.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'get the last row whith sheets names
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile
Set wbTheOtherWB = Workbooks(sFile)
With wbTheOtherWB
For i = 1 To LastRow 'rows in current workbook with worksheets names
WSName = wbThisWB.Worksheets("Sheet1").Cells(i, 1) 'where you place sheets names (here column A, from row 1 down)
If sheetExists(WSName, wbTheOtherWB) Then
Set wsSht = .Sheets(WSName)
wsSht.Copy before:=wbThisWB.Sheets("Sheet1")
Else
MsgBox "There is no sheet with name : " & WSName & " in:" & vbCr & .Name
End If
Next
wbTheOtherWB.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Function sheetExists(sheetToFind As String, wbTheOtherWB As Workbook) As Boolean
sheetExists = False
For Each Sheet In wbTheOtherWB.Worksheets
If sheetToFind = Sheet.Name Then
sheetExists = True
Exit Function
End If
Next Sheet
End Function