Move a sheet from closed workbook (almost 90%)

[Mr.Karr]

Hello,

Can anyone please modify the below snippet to move a sheet from a closed workbook.
In detail: I have sheet name in cell A1 (Source sheet name "Start")

Can you please modify that part to take the value from cell A1 from source sheet & move that sheet alone ?

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 = Sheets(Range("AE9").Value) Then
Set wsSht = .Sheets(Range("AE9").Value)
wsSht.Copy after:=sThisBk.Sheets("Start")


Else
MsgBox "There is no sheet with name :MCS Forecast in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If

Thanks in advance,
Karthik

 

[dianacris]

Hope this helps.

Public Sub ImportSheet()

Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook, wbBk As Workbook
Dim wsSht As Worksheet
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(sThisBk.Worksheets("Start").Range("A1").Value, wbBk) Then
            Set wsSht = wbBk.Sheets(sThisBk.Worksheets("Start").Range("A1").Value)
            wsSht.Copy after:=sThisBk.Sheets("Start")
        Else
            MsgBox "There is no sheet with name :MCS Forecast in:" & vbCr & .Name
        End If
       
        wbBk.Close SaveChanges:=False
    End With
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Function SheetExists(ByVal sWorksheetName As String, sWkBk As Workbook) As Boolean
Dim Sht As Worksheet

For Each Sht In sWkBk.Worksheets
    If Application.Proper(Sht.Name) = Application.Proper(sWorksheetName) Then
        SheetExists = True
        Exit Function
    End If
Next Sht
SheetExists = False
End Function

 

[Mr.Karr]

this works like a breeze. Thanks @dianacris