Solved: Move rows to new work book based on a cell value.

[rajesh nag]

Hi,

I have created a macros which transfers data in existing work book.

Here is the sample code.

[VBA]
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
[/VBA]

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.

[rajesh nag]

Hi,

I have created a macros which transfers data in existing work book.

Here is the sample code.

[vba]
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
[/vba]
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.

Finaly I have the macros which full fill my needs

Here are the codes.

[VBA]Sub CopySheets()
Dim i As Long, s As String
s = ThisWorkbook.Name

If Sheets("Test").Cells(2, 254).Text <> "" Then
Sheets(Array("Test", "Open PO", "Closed PO", "NEW")).Copy

Workbooks(Workbooks.Count).SaveAs _
Filename:="D:\" + Sheets("Test").Cells(2, 254).Text + "_Report.xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Sheets("test").Delete
ActiveWorkbook.Save

Workbooks(Workbooks.Count).Close
Sheets("Open PO").Delete
Sheets("Closed PO").Delete
Sheets("NEW").Delete
ActiveWorkbook.Save
End If
Windows(s).Activate

End Sub[/VBA]