Excelマクロ内の条件に基づいた情報のコピー

Question

Excelごとにオープンインボイスのリストがオフィスごとに表示されています。マクロを使用して、オフィスごとにこれらの未処理の請求書を異なるExcelシートに分割し、各シートをオフィス番号として保存するにはどうすればよいですか？以下は、最初の列がオフィス番号であるサンプルリストです。関連付けられた行全体が新しいシートにコピーされる必要があります。

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 SUE  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 

Answer 1

これを試してください。オフィス番号が列Aで列見出しがあると仮定すると、それはうまくいくはずです：

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