rajesh nag
01-12-2009, 03:43 AM
Hi,
I have created a macros which transfers data in existing work book.
Here is the sample code.
Option Explicit
Sub DistributeRows()
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
Dim LastRowCrit As Long
Dim I As Long
Set wsAll = Worksheets("Test")
LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
Set wsCrit = Worksheets.Add
wsCrit.Range("A1") = wsAll.Range("d1")
wsCrit.Range("A2") = "Closed PO"
Set wsNew = Worksheets.Add
wsAll.Range("A1:an" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True
Set wsCrit = Worksheets.Add
wsCrit.Range("A1") = wsAll.Range("d1")
wsCrit.Range("A2") = "Open PO"
Set wsNew = Worksheets.Add
wsAll.Range("A1:an" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True
Set wsCrit = Worksheets.Add
wsCrit.Range("A1") = wsAll.Range("d1")
wsCrit.Range("A2") = "NEW"
wsCrit.Range("A3") = "New"
wsCrit.Range("A3") = "new"
Set wsNew = Worksheets.Add
wsAll.Range("A1:an" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True
End Sub
And i have user form which stores value in IU2 which matches with column "C". My need is once i post the value to IU2 thorugh user form.
Open a work book and transfer the data for the above status into individual sheets and save work book with value in IU2 appending with _report and name the sheets with the above status names.
Regards,
Rajesh.
I have created a macros which transfers data in existing work book.
Here is the sample code.
Option Explicit
Sub DistributeRows()
Dim wsAll As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim LastRow As Long
Dim LastRowCrit As Long
Dim I As Long
Set wsAll = Worksheets("Test")
LastRow = wsAll.Range("A" & Rows.Count).End(xlUp).Row
Set wsCrit = Worksheets.Add
wsCrit.Range("A1") = wsAll.Range("d1")
wsCrit.Range("A2") = "Closed PO"
Set wsNew = Worksheets.Add
wsAll.Range("A1:an" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True
Set wsCrit = Worksheets.Add
wsCrit.Range("A1") = wsAll.Range("d1")
wsCrit.Range("A2") = "Open PO"
Set wsNew = Worksheets.Add
wsAll.Range("A1:an" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True
Set wsCrit = Worksheets.Add
wsCrit.Range("A1") = wsAll.Range("d1")
wsCrit.Range("A2") = "NEW"
wsCrit.Range("A3") = "New"
wsCrit.Range("A3") = "new"
Set wsNew = Worksheets.Add
wsAll.Range("A1:an" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsCrit.Range("A1:A2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True
End Sub
And i have user form which stores value in IU2 which matches with column "C". My need is once i post the value to IU2 thorugh user form.
Open a work book and transfer the data for the above status into individual sheets and save work book with value in IU2 appending with _report and name the sheets with the above status names.
Regards,
Rajesh.