Copy Sheets - VBA

Ron512

Board Regular
Joined
Nov 17, 2002
Messages
98
I require some assistance adjusting a macro.

The macro below is designed to copy all of the sheets from all workbooks in the user selected folder.

I would like to change the code to be more selective on which sheets in the workbooks are copied. Each workbook has a sheet named “Index”. I want only the sheets to the right of the sheet named “Index” to be copied.

Disclosure: some of this code has been obtained from this site and perhaps others.

Thanks for the help.

Ron

Code:
 '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 = "Please select the folder of the excel files to copy."
    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 MasterIndex()
    Dim path            As String
    Dim FileName        As String
    Dim LastCell        As Range
    Dim Wkb             As Workbook
    Dim ws              As Worksheet
    Dim ThisWB          As String
     
Application.ScreenUpdating = False
Application.DisplayAlerts = False
     
    On Error Resume Next
     
    ThisWB = ThisWorkbook.Name
    path = GetDirectory
    FileName = Dir(path & "\*.xls", vbNormal)
    Do Until FileName = ""
        If FileName <> ThisWB Then
            Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName, UpdateLinks:=0)
           
            For Each ws In Wkb.Worksheets
                With ThisWorkbook
                        ws.Copy after:=.Worksheets(.Worksheets.Count)
                 End With
            Next ws
             
            Wkb.Close False
        End If
        FileName = Dir()
    Loop
     
    ActiveWorkbook.Sheets("Total").Select
    Range("A1").Select
       
    Set Wkb = Nothing
    Set LastCell = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True
     
End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Forum statistics

Threads
1,213,510
Messages
6,114,034
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top