Need macro help

[vinu]

Hello all,


Need a code to perfrom the below task.

I have one excel file with many sheets. Macro should ideally move particular sheet to new work book and save it in desktop. while moving it should check 2 conditions. In this file I have two drop down in c1 and d1 cells. In c1 drop down contains sheet names. D1 cell drop down contains like "blank" and "non blank" - it should filter only blank/non blank cells in column z in the selected sheet name in c1 cell and move that sheet to new workbook and save it to desktop. I want to copy n move, so that i cant make any change in the original file.


Please help me.


Regards,

vinu

 

[kchiba]

Hi Vinu,


Under what circumstances do you want the copy and move to happen.


Do you want to :


1. Select a sheetname in C1

2. Select blank / non blank in D1

3. Press a button to do the copy and save

4. What is the new file Saved as?


I will try some VBA when I get your reply


Kanti

 

[vinu]

Hi Kanti


Correct. and File name should be same as sheet name.

 

[kchiba]

Hi Vinu,


Below is the code, please note that the I have not created the drop-downs and that the sheet with the drop-downs should be named "Main"


Cell A1 = Name of sheet

Cell B1 = Blank/ Non-Blank

Cell D1 = Folder name, example C:UsersOfficeworksDesktop


Best of luck, let me know if you need more help with this


Option Explicit


Sub CreateWkbs()


' Created by Kanti Chiba 21 June 2010


Dim tWks As Worksheet

Dim Main As Worksheet

Dim strWks As String

Dim sWkb As Workbook

Dim tFolder As String

Dim myCrit As String

Dim nWkb As Workbook


Set sWkb = ThisWorkbook

Set Main = sWkb.Sheets("Main")


strWks = Main.Range("A1")

Set tWks = sWkb.Sheets(strWks)

myCrit = Main.Range("b1")


tFolder = Main.Range("D1")


If Right(tFolder, 1) <> "" Then

tFolder = tFolder & ""

End If


Set nWkb = Workbooks.Add


tWks.Activate

Range("b1").Select

Selection.AutoFilter

If myCrit = "Blank" Then

Selection.AutoFilter Field:=2, Criteria1:="="

Else

Selection.AutoFilter Field:=2, Criteria1:="<>"

End If

Selection.SpecialCells(xlCellTypeVisible).Copy nWkb.Sheets("Sheet1").Range("A1")

nWkb.SaveAs tFolder & strWks & ".xls"


nWkb.Close


End Sub

 

[vinu]

Hi Kanti,


Its not working fully. As I uploaded one excel formula and even i highlighted the column which macro should filter.


could you please chk and let me know.

the file link is : http://www.scribd.com/doc/33353832/Prob-Macro


Regards,

vinu.

 

[kchiba]

Hi Vinu,

Sorry I thought you colud edit the VBA, however, I have made the column flexible,

just put the address of the column you want to filter in column C on Main


So Row 1 of Main look like this:


A1 = One

B1 = Non-Blank

C1 = Z1

D1 = C:Documents and SettingsKantilal.Chiba.ASIA-PACDesktop


the revised macro is below


Sub CreateWkbs()


' Created by Kanti Chiba 21 June 2010

'Revised 22/6/2010


Dim tWks As Worksheet

Dim Main As Worksheet

Dim strWks As String

Dim sWkb As Workbook

Dim tFolder As String

Dim myCrit As String

Dim nWkb As Workbook

Dim cCol As Range

Dim cColn As Integer


Set sWkb = ThisWorkbook

Set Main = sWkb.Sheets("Main")


strWks = Main.Range("A1")

Set tWks = sWkb.Sheets(strWks)

myCrit = Main.Range("b1")


tFolder = Main.Range("D1")

Set cCol = Main.Range("C1")

cColn = Range(cCol).Column


If Right(tFolder, 1) <> "" Then

tFolder = tFolder & ""

End If


Set nWkb = Workbooks.Add


tWks.Activate

Range("b1").Select

Selection.AutoFilter

If myCrit = "Blank" Then

Selection.AutoFilter Field:=cColn, Criteria1:="="

Else

Selection.AutoFilter Field:=cColn, Criteria1:="<>"

End If

Selection.SpecialCells(xlCellTypeVisible).Copy nWkb.Sheets("Sheet1").Range("A1")

nWkb.SaveAs tFolder & strWks & ".xls"


nWkb.Close


End Sub

 

[vinu]

Thanks a lot..!