Filter, Split And Move Data For Each Month From Master Workbook To Individual Sheet

Hi,

Need someone help on creating a MACRO for the attached excel sheet, Data in file contains three month data of 2010.


Every Month first day i need to pull the last month data in to one new excel. For eg. If current month is May, then i need to pull previous month (April) data in to one new excel.

Now My need is, I need a macro where i need to enter the certain month in the dialog box and that file need to pull thay month data into new excel sheet.

Can anyone help me on this.



Many Thanks In Advance,

So the month you provide in the input box will be one of the months that is available in the data sheet, right? And this should then be copied over to a new workbook? or a new sheet within the same workbook?

Thanks for your reply,

Yes your are right, But given workbook contains only 2 month data, i have a raw data in my desktop which contains 12 months data.

It should be copied over to a new workbook. :)

Try this...

Code:

---

Sub Consolidator()

    Dim wbk As Workbook
    Dim wbkNew As Workbook
    Set wbk = ThisWorkbook 'if you are running the code from the source file.
    'If not, you can refer it to the workbook directly as Workbooks("Data 2010") and replace the above code with
    'Set wbk = Workbooks("Data 2010")
    'Note that the Workbooks("Data 2010") should be open when the macro is run
    Set wbkNew = Workbooks.Add(xlWorksheet)
    Dim strMonthFilter As String
    strMonthFilter = "1 " & Format(InputBox("Enter Month With Year. Ex: March 2013, or Mar 2013", "Filter Monthly Data", Format(Date, "mmm yyyy"), Application.Width / 2, Application.Height / 2), "mmm yyyy")
    If IsDate(strMonthFilter) Then
        With wbk.Sheets(1)
            .AutoFilterMode = False
            .Range("$A$1:$AH$" & .Cells(.Rows.Count, 1).End(xlUp).Row).AutoFilter Field:=12, Operator:=xlFilterValues, Criteria2:=Array(1, strMonthFilter)
            .Range("$A$1:$AH$" & .Cells(.Rows.Count, 1).End(xlUp).Row).Copy wbkNew.Sheets(1).Cells(1)
        End With
    Else
        MsgBox "Please enter a valid date in MMMM YYYY format", vbOKOnly, ""
    End If
    'If you want to save and close the new file, use
    wbkNew.SaveAs wbk.Path & Application.PathSeparator & Mid(strMonthFilter, 3)
    wbkNew.Close 0
   
End Sub

---

You could add a check weather the workbook is opened or not.

Code:

---

Function BookOpen(wbName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(wbName)
BookOpen = Not (Err.Number > 0)
End Function

---

Add the next line to the macro provided by EF

Code:

---

If Not BookOpen("Data 2010") Then Workbooks.Open ThisWorkbook.Path & "\" & "Data 2010.xlsx"

---

Ajust the filepath accordingly.

Hi,
Hav run the macro, but data's was not copying into another sheet. It copying only the header...

Change this line

Code:

---

.Range("$A$1:$AH$" & .Cells(.Rows.Count, 1).End(xlUp).Row).Copy wbkNew.Sheets(1).Cells(1)

---

into this one

Code:

---

.AutoFilter.Range.SpecialCells(xlVisible).Copy wbkNew.Sheets(1).Cells(1)

---

This should solve your problem.