Copying Information based on conditions in an Excel Macro
I have a list of open invoices listed in Excel per office. How can I use a macro to split these open invoices per office into different Excel sheets, and then save each sheet as the office number? Below is a sample list where the first column is the office number, the entire line associated would have to be copied over to the new sheet.
1 180 JOHN 30073 COMPANY X 15,101 173,758 255,713 8/1/2011 8,101 8/24/11 Adair has approved the rates!
1 278 ADAM 159334 COMPANY A 28,606 116,174 158,925 5/9/2011 167,631 7/18/11 Julie Levinsohn still needs to look at reduced entries to see if we can resubmit.
2 600 ROSE 113724 COMPANY 123 0 5,918 20,446 8/22/2011 6,713 8/26/11 Em M Belcher Jul invs per her request.
2 289 SUE 149232 COMPANY BC 389 5,575 12,098 4/22/2011 328 8/23/11 Em w/jun inv to R. Kos
2 169 MIKE 120126 COMPANY 98 41,907 5,218 202,756 8/18/2011 33,635 8/24/11 Jun invs to be pd mid sept per Patrice.
2 849 BOB 63068 COMPANY CB 2,862 4,889 9,271 4/25/2011 4,279 8/23/11 Called Choi re when and how much she will send.
2 849 LANEY 170318 COMPANY 34 0 4,123 6,283 6/30/2011 270 8/17/11 Robert em me re working w/cj re problem w/retainer hrs and bills.
2 707 BOB 153213 COMPANY CI 0 3,127 3,127 5/6/2011 257 4/27/11 Appeals for some of the shortpays by insurance co are pending per
2 141 SUE 65267 COMPANY Z 9,652 2,313 12,546 7/20/2011 8,380 8/16/11 Stmt em to Pat for pmt of os invs.
2 705 MIKE 173993 COMPANY X 5,020 2,240 7,294 7/19/2011 1,120 8/24/11 Pmt is processing.
2 763 JOHN 85919 COMPANY LK 3,500 0 4,500 8/22/2011 1,014 8/19/11 Inv 5637061 in a/p for pmt per cl.
2 400 MIKE 41218 COMPANY 90 3,433 0 3,433 8/24/2011 2,270 5/27/09 Per Hall, ck has been signed and mailed for Feb inv.
3 164 MIKE 133625 COMPANY LO 500 19,351 21,795 7/25/2011 636 8/16/11 Em to B. Kampas re my calling for pmt
3 178 BOB 168512 COMPANY GH 889 15,749 17,030 6/9/2011 2,322 8/24/11 L/m for M Cornejo to call re osbal due.
3 1005 S开发者_高级运维UE 164680 COMPANY TH 0 13,862 14,459 8/24/2010 5,000 07/06/11 snt ar statement.dtelles
3 164 LANEY 61383 COMPANY RT 0 11,077 65,316 7/29/2011 31,750 8/30/11 Inv 5567542 being revised per
3 171 SUE 78029 COMPANY 345 0 10,507 20,385 8/15/2011 10,165 8/26/11 May invs em to susan
3 164 JOHN 62161 COMPANY 383 14,000 10,500 73,376 8/22/2011 3,500 8/26/11 Invs 5655722 and 5629996 are flat fee bills
3 1139 MIKE 169932 COMPANY 282 145 10,401 10,546 8/24/2011 800 8/26/11 $800 recd.
3 171 CHRIS 134278 COMPANY 202 0 9,603 9,603 8/15/2011 38,300 8/11/11 JP em from Myriam that ck cut today
3 1363 CHRIS 166031 COMPANY CW 0 8,987 8,987 9/17/2010 4,104 8/3/11 em to Brad K about speaking to Charles
3 171 JOHN 139383 COMPANY WE 3,872 8,712 23,575 8/19/2011 5,608 07/06/11 snt ar stmnt.
3 198 MIKE 118294 COMPANY LC 0 3,262 3,262 3/9/2011 1,000 8/15/11 Em Cl for a $500 pmt.
3 1139 BOB 176647 COMPANY XC 0 2,673 11,648 7/26/2011 12,152 8/24/11 Em w/may inv sent to for pmt.
3 1223 BOB 163879 COMPANY NC 4,550 185 4,735 8/15/2011 32,815 8/4/11 Mar, Apr May invs revised and sent to Cl
3 1139 BOB 169094 COMPANY 321 5,000 173 12,728 7/20/2011 4,730 8/30/11 CP em Gayle W9 and inv 5625894
3 178 SUE 5416 COMPANY DW 2,670 0 9,596 8/8/2011 2,496 8/24/11 Sent stmt to V. Wu.
3 762 CHRIS 112507 COMPANY IC 6,000 0 12,293 8/8/2011 4,013 07/06/11 snt ar stmnt.
3 631 JOHH 108718 COMPANY IF 15,842 0 43,215 8/26/2011 5,515 07/06/11 snt ar stmnt
4 133 LANEY 157042 COMPANY IR 0 92,879 114,157 5/6/2011 116,483 08/18/2011,jw, emailed Carolyn
4 502 LANEY 66422 COMPANY IG 30,291 58,792 160,301 8/23/2011 24,512 9/17/10 JP sent f/u em to Robin re past due inv
4 155 CHRIS 72564 COMPANY 853 3,283 55,918 62,367 8/4/2011 500 10/19/05 lg recd call from karen,invs will be pd as of next week
4 500 BOB 128230 COMPANY URE 850 49,217 51,006 12/3/2010 2,353 06/29/2011,jw, asked Dk for collection ypdate
4 751 MIKE 174393 COMPANY KRIG 0 42,753 60,057 7/5/2011 3,658
4 1384 JOHN 143392 COMPANY IR 0 42,468 42,468 10/27/2010 -2,500 7/20/11 Account turned over to collections.
4 1135 MIKE 169399 COMPANY IGD 1,517 38,857 44,108 7/3/2011 1,539 07/07/2011,jw, emailed Jake for collecti on update
4 1135 CHRIS 151511 COMPANY IGDS 608 37,458 42,010 7/29/2011 5,691 07/07/2011,jw, emailed Jake for collection update
5 101 BOB 140464 COMPANY IDGS 0 9,226 16,185 7/20/2011 1,120 10/13/10 JP call from Sun req copy of os inv be em
5 281 JOHN 155780 COMPANY IERE 0 9,214 14,557 8/22/2011 13,097 5/3/11Inv 5440713 to clnt mi
5 288 JOHN 86325 COMPANY 832 1,140 9,178 11,458 8/22/2011 2,824 12/10/09 am received em advising they r moving
Try this; it should work, assuming the office number is column A and there are row headings:
Dim Source As Range
Dim OfficeNumber As String
Dim PrevOfficeNumber As String
Dim CurrentSheet As Worksheet
Dim NewSheet As Worksheet
Set Source = Cells(1, 1).CurrentRegion
Set CurrentSheet = ActiveSheet
For Row = 1 To Source.Rows.Count
OfficeNumber = CurrentSheet.Cells(Row, 1)
If OfficeNumber <> PrevOfficeNumber Then
' create a new sheet
newrow = 1
Set NewSheet = Application.Sheets.Add
NewSheet.Name = OfficeNumber
PrevOfficeNumber = OfficeNumber
End If
' copy row to new sheet
CurrentSheet.Cells(Row, 1).EntireRow.Copy (NewSheet.Cells(newrow, 1))
newrow = newrow + 1
Next
精彩评论