Help Needed: How to pick a specific tab out of a worksheet?

[vinkhera]

Hello All,

I am new to this forum. Seems like a great forum to learn. I have created a Macro. My purpose to create this macro was to click a button that would ask you to select a folder from a browse window and once you select the folder, it would copy all the spreadsheets and put those spreadsheets on to a different tab where I click my button.

Then I created another macro so I could merge all the tabs in to one tab. I am almost at the end.

However this is what I need at this point.

I need the macro to only choose first tab which is called 'Losses' from each spreadsheet within a folder and spit it on to one spreadsheet regardless regardless of the number of spreadsheet there are within a folder. Currently, the macro copies all tabs from the spreadhseets and spits those in to one sheet.

See my code below:

Option Explicit

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
pszpath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
As Long

Public Type BrowseInfo
hOwner As Long
pIDLRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Function GetDirectory(Optional msg) As String
On Error Resume Next
Dim bInfo As BrowseInfo
Dim path As String
Dim r As Long, x As Long, pos As Integer

'Root folder = Desktop
bInfo.pIDLRoot = 0&

'Title in the dialog
If IsMissing(msg) Then
bInfo.lpszTitle = "G:\PGMS\CLAIMSRPT\2011\2011 01"
Else
bInfo.lpszTitle = msg
End If

'Type of directory to return
bInfo.ulFlags = &H1

'Display the dialog
x = SHBrowseForFolder(bInfo)

'Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

Sub CombineFiles()
Dim path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim ws As Worksheet
Dim ThisWB As String

ThisWB = ThisWorkbook.Name
Application.EnableEvents = False
Application.ScreenUpdating = False
path = GetDirectory
FileName = Dir(path & "\*.xls", vbNormal)
Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
For Each ws In Wkb.Worksheets
Set LastCell = ws.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
Else
ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next ws
Wkb.Close False
End If
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

Set Wkb = Nothing
Set LastCell = Nothing
End Sub
---------------------------------------------
Here is my code to merge all tabs in to one tab once the first macro spits all spreadsheets to different tabs.

Sub Mergetabs()
'========================================================================
' THIS MERGES "VALUES" AND FORMATTING OF ALL SHEETS IN WORKBOOK
' ONTO A NEW SHEET ADDED AS FIRST SHEET
'========================================================================
Dim ws As Worksheet
Sheets.Add Before:=Sheets(1)
Sheets(1).Activate
ActiveSheet.UsedRange.Offset(0).Clear
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> ActiveSheet.Name Then
ws.UsedRange.Copy
With Range("A65536").End(xlUp).Offset(1, 0)
.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End With
End If
Next
End Sub
---------------------------------------------------------
Any help would be greatly appreciated.
<!-- / message -->