开发者

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
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜