Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
This code works great as that it copies all the worksheets within a directory
into a new single workbook. However I need two modifications, I need it to only pull the worksheets called "Reports", and when it copies it to the new workbook I need it to copy it as values. This code was provided from an earlier post from Ron de Bruin Sub Test_1() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String Dim Fnum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim CalcMode As Long 'Sheets("Report").Select 'Fill in the path\folder where the files are MyPath = "H:\myprojdir\GWIS\Humble\Test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If 'Fill the array(myFiles)with the list of Excel files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With 'Add a new workbook with one sheet Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) BaseWks.Name = "wertyu" 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then On Error Resume Next mybook.Worksheets.Copy _ after:=BaseWks.Parent.Sheets(BaseWks.Parent.Sheets .Count) End If mybook.Close savechanges:=False Next Fnum Application.DisplayAlerts = False BaseWks.Delete Application.DisplayAlerts = True End If 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub Thanks again |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Drop Down/List w/Code and Definition, only code entered when selec | Excel Worksheet Functions | |||
Convert a Number Code to a Text Code | Excel Discussion (Misc queries) | |||
Unprotect Code Module in Code | Excel Discussion (Misc queries) | |||
copying vba code to a standard code module | Excel Discussion (Misc queries) | |||
Editing the name box | New Users to Excel |