PDA

View Full Version : Sleeper: Sorting sheets by month from different workbooks into one



babycody
06-12-2005, 08:16 PM
I have several workbooks in one folder. The first sheet is named something simular to FB 233 JUN-10-2005 in all the workbooks. Where 233 could change and the date could change. I would like to be able to combine these sheets into one workbook according to the month they belong in. i.e. FB 233 JUN-10-2005 would go in the JUN workbook, and FB 265 JUL-12-2005 would go into JUL workbook. The workbooks would need to be created and saved to a path I specify. This code might be run frequently, and I want to avoid duplicate sheets if it is run often. i.e. NO FB 233 JUN-10-2005(2) sheet put into workbook. Any duplicates should replace the original sheet in the workbook in case sheet has changes made to it for that day. If you post some code please let me know what module it goes into. Thanks.

Bob Phillips
06-13-2005, 05:14 AM
Here is a start



Sub DateFiles()
Const BaseFolder As String = "C:\People"
Const TargetFolder As String = "C:\Dates\"
Dim oMe As Workbook
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim oWBGet As Workbook
Dim oWBDate As Workbook
Dim tmpDate As Date
Dim iPos As Long
Dim sSheet As String
Dim sWBName As String
Set oMe = ThisWorkbook
Set oFSO = CreateObject("Scripting.FileSystemobject")
Set oFolder = oFSO.GetFolder(BaseFolder)
Application.SheetsInNewWorkbook = 1
For Each oFile In oFolder.Files
Set oWBGet = Workbooks.Open(oFile.path)
sSheet = oWBGet.Worksheets(1).Name
iPos = InStrRev(sSheet, " ")
If iPos > 1 Then
tmpDate = CDate(Right(sSheet, Len(sSheet) - iPos))
sWBName = Format(tmpDate, "mmm") & ".xls"
On Error Resume Next
Set oWBDate = Workbooks(sWBName)
On Error GoTo 0
If oWBDate Is Nothing Then
Set oWBDate = Workbooks.Add
oWBDate.SaveAs TargetFolder & sWBName
oWBGet.Worksheets(1).Copy After:=oWBDate.Worksheets(oWBDate.Worksheets.Count)
Application.DisplayAlerts = False
oWBDate.Worksheets(1).Delete
Application.DisplayAlerts = True
Else
oWBGet.Worksheets(1).Copy After:=oWBDate.Worksheets(oWBDate.Worksheets.Count)
End If
Else
MsgBox oFile.path & " is invalid format"
End If
oWBGet.Close savechanges:=False
Next oFile
End Sub

babycody
06-13-2005, 08:14 PM
This does work very well. The one big problem I see is that it doesn't create a different workbook for each month. It created a JUN.xls workbook and added JUN, JUL, and MAR sheets to the JUN.xls workbook. It would also be nice if it automatically saved the workbooks, and closed them when each was done. Would I need to just change oWBGet.Close savechanges:=False to true for this to happen? Other than that it worked nicely. Can you help me fix that one problem please? Thanks for your help.

This is an example of the workbook I am using.

babycody
06-13-2005, 08:21 PM
Your code: