How to Import Specific Sheet to Another Workbook with VBA - vba

Question

I try to create a program that can collect every "UTP" sheet in one folder into one "Master UTP" workbook (located in the same folder)
So, first I need to read all file xls in folder.
Copy "UTP" sheet and paste it to "Master UTP".
Then do looping again.
This is the code that I make so far in "Master UTP":
Public Sub myImport()
Dim sPathName As String, sFileName As String
Dim sourceWb As Workbook, targetWb As Workbook
Set sourceWb = ActiveWorkbook
sPathName = ThisWorkbook.Path & "\"
sFileName = Dir(sPathName & "*.xls", vbNormal)
Do While Len(sFileName) > 0
sFileName = sPathName & sFileName
If sFileName <> sourceWb Then
Set targetWb = Workbooks.Open(sName)
targetWb.Sheets("UTP").Copy After:=sourceWb.Sheets("Master UTP")
targetWb.Close
End If
sFileName = Dir
Loop
End Sub
There still some mistake in this program. Please help.
Thanks.

Answer 1

Building on #chrisneilsen 's solution, here'a more compact code:
Option Explicit
Public Sub myImport()
Dim sPathName As String, sFileName As String
Dim targetSht As Worksheet
Set targetSht = ActiveWorkbook.Worksheets("Master UTP")
sPathName = ThisWorkbook.Path & "\"
sFileName = Dir(sPathName & "*.xls", vbNormal)
Do While Len(sFileName) > 0
If sFileName <> targetSht.Parent.Name Then
On Error Resume Next
With Workbooks.Open(sPathName & sFileName)
.Sheets("UTP").Copy After:=targetSht
.Close False
End With
On Error GoTo 0
End If
sFileName = Dir
Loop
End Sub
which should be even slightly more compacted if it can be safely assumed that ActiveWorkbook is a "macro" one, i.e. with a "xlsm" type in its name, so that it can never match any "xls" name:
Option Explicit
Public Sub myImport()
Dim sPathName As String, sFileName As String
Dim targetSht As Worksheet
Set targetSht = ActiveWorkbook.Worksheets("Master UTP")
sPathName = ThisWorkbook.Path & "\"
sFileName = Dir(sPathName & "*.xls", vbNormal)
Do While Len(sFileName) > 0
On Error Resume Next
With Workbooks.Open(sPathName & sFileName)
.Sheets("UTP").Copy After:=targetSht
.Close False
End With
On Error GoTo 0
sFileName = Dir
Loop
End Sub
Finally, you could appreciate eliminate the flickering at any xls file opening, so you maight enclose the loop inside Application.ScreenUpdating = False/True statements:
Option Explicit
Public Sub myImport()
Dim sPathName As String, sFileName As String
Dim targetSht As Worksheet
Set targetSht = ActiveWorkbook.Worksheets("Master UTP")
sPathName = ThisWorkbook.Path & "\"
sFileName = Dir(sPathName & "*.xls", vbNormal)
Application.ScreenUpdating = False
Do While Len(sFileName) > 0
On Error Resume Next
With Workbooks.Open(sPathName & sFileName)
.Sheets("UTP").Copy After:=targetSht
.Close False
End With
On Error GoTo 0
sFileName = Dir
Loop
Application.ScreenUpdating = True
End Sub

Answer 2

First issue is you try an open sName rather than sFileName (Use of Option Explicit would detect this error)
Second issue, you are comparing string to a workbook in If sFileName <> sourceWb Then
Third issue, workbook.name doesn't include the path
Your code, refactored, and some error handling added
Public Sub myImport()
Dim sPathName As String, sFileName As String
Dim sourceWb As Workbook, targetWb As Workbook
Dim ws As Worksheet
Set sourceWb = ActiveWorkbook
sPathName = ThisWorkbook.Path & "\"
sFileName = Dir(sPathName & "*.xls", vbNormal)
Do While Len(sFileName) > 0
If sFileName <> sourceWb.Name Then ' <-- sourceWb.Name does not include path
Set targetWb = Nothing
On Error Resume Next ' <-- in case Open fails
Set targetWb = Workbooks.Open(sPathName & sFileName) '<-- use correct variable sFileName
On Error GoTo 0
If Not targetWb Is Nothing Then
Set ws = Nothing
On Error Resume Next ' <-- in case sheet does not exist
Set ws = targetWb.Worksheets("UTP")
On Error Resume Next
If Not ws Is Nothing Then
ws.Copy After:=sourceWb.Worksheets("Master UTP")
End If
targetWb.Close False
End If
End If
sFileName = Dir
Loop
End Sub

Answer 3

Your code looks fine except for the error where you try and open the other workbooks. You try and open workbooks from the variable sName which is never used. You also reset the sFileName variable needlessly, instead try using sPathName & sFileName as the input for Workbooks.Open().
Also, you try and compare the sFileName to the sourceWb which are two different data types, instead compare sFileName to sourceWb.Name.
Finally, you assume that the workbook will have a worksheet named "UTP", if it doesn't the code will crash. Instead check if the sheet exists first. View https://stackoverflow.com/a/6040390/8520655 for more information.
Please view below for example;
Public Sub myImport()
Dim sPathName As String, sFileName As String
Dim sourceWb As Workbook, targetWb As Workbook
Set sourceWb = ActiveWorkbook
ActiveSheet.Cells(1, 1).Value = sourceWb.Name
sPathName = ThisWorkbook.Path & "\"
sFileName = Dir(sPathName & "*.xls", vbNormal)
Do While Len(sFileName) > 0
ActiveSheet.Cells(1, 2).Value = sFileName
If sFileName <> sourceWb.Name Then
Set targetWb = Workbooks.Open(sPathName & sFileName)
If SheetExists("UTP", targetWb) Then
targetWb.Sheets("UTP").Copy After:=sourceWb.Sheets("Master UTP")
End If
targetWb.Close
End If
sFileName = Dir
Loop
End Sub
Function SheetExists(SheetName As String, Optional wb As Excel.Workbook)
Dim s As Excel.Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set s = wb.Sheets(SheetName)
On Error GoTo 0
SheetExists = Not s Is Nothing
End Function