Copy Specific Sheet from another worbook to active workbook

[EddyVilla]

hi,

i'm starting at VBA and what i want to do is to load the files into a listbox (excel files, already done) and then when an specific workbook is selected i want to grab/copy a sheet called "Yield" from the selected sheet and paste it into my workbook. (MainMenu_c)

So i have the following code which works OK (found it online) however i'm unable to adapt it to only copy "Yield" sheet... Thank you!

Private Sub UserForm_Initialize()
Dim objFSO, objFile As Object
Dim strDirectory As String


Set objFSO = CreateObject("Scripting.FileSystemObject")


strDirectory = "\\xxxx\xxx\xx\Core\DX\Weekly Metrics\Wk's 01-52 2013\"
Me.txtDirectory = strDirectory


    For Each objFile In objFSO.GetFolder(strDirectory).Files
        If StrConv(Right(objFile.Name, 4), vbUpperCase) = "XLSX" Then
            ListBox1.AddItem objFile.Name
        End If
    Next
End Sub




Private Sub cmdOK_Click()


Application.ScreenUpdating = False


Dim sh As Worksheet, wb As Workbook, wb2 As Workbook, shcopy As Worksheet


Set wb = Workbooks("MainMenu_C.xlsm")


Workbooks.Open Me.txtDirectory & "" & ListBox1, ReadOnly:=True
For Each sh In Workbooks("" & ListBox1).Worksheets
 sh.Copy After:=wb.Sheets(wb.Sheets.Count)
Next sh
Sheets(1).Select
Application.ScreenUpdating = True
Unload Me


End Sub
Private Sub cmdCancel_Click()
    Unload Me
   
End Sub

 

[vds1]

Try,

Private Sub UserForm_Initialize()
Dim objFSO, objFile As Object
Dim strDirectory As String




Set objFSO = CreateObject("Scripting.FileSystemObject")




strDirectory = "\\xxxx\xxx\xx\Core\DX\Weekly Metrics\Wk's 01-52 2013\"
Me.txtDirectory = strDirectory




    For Each objFile In objFSO.GetFolder(strDirectory).Files
        If StrConv(Right(objFile.Name, 4), vbUpperCase) = "XLSX" Then
            ListBox1.AddItem objFile.Name
        End If
    Next
End Sub








Private Sub cmdOK_Click()




Application.ScreenUpdating = False




Dim sh As Worksheet, wb As Workbook, wb2 As Workbook, shcopy As Worksheet




Set wb = Workbooks("MainMenu_C.xlsm")




Workbooks.Open Me.txtDirectory & "" & ListBox1, ReadOnly:=True
For Each sh In Workbooks("" & ListBox1).Worksheets
 If UCase(sh.Name) = "YIELD" Then
    sh.Copy After:=wb.Sheets(wb.Sheets.Count)
 End If
Next sh
Sheets(1).Select
Application.ScreenUpdating = True
Unload Me




End Sub
Private Sub cmdCancel_Click()
    Unload Me
   
End Sub

 

[EddyVilla]

it worked! thank you !!!!!

 

[vds1]

Thank you for your feedback. Good day.