条件に基づいて別のシートに行をコピーする

Question

私はこのウェブサイトで回答を探していますが、何か関連するものを見つけることができず、誰かが助けてくれるか不思議でした。

私は優れた文書を持っています。

シート1はEXT 1204及びいわゆるれる内線番号、例えば、シート2はEXT 1203シート4と呼ばれるEXT 1202シート3と呼ばれる1204

EXT 1202 EXT 1203 EXTのリストを含みますに。

"EXT 1202"という単語が含まれているすべての行についてシート1をスキャンし、EXT 1202というシートにコピーした後、シート1からすべての行をコピーするマクロを実行する必要がありますEXT 1203という単語が含まれていて、それを1203という名前のシートにコピーしてください。

PS Microsoft Excel 2010で働いています これは基本的に私が電話をかけた内線番号を見つけ出し、コール。別のシートにある各内線番号のデータが好きなのは、その人がコピーを必要とする場合、文字通り各シートを印刷できるからです。

最後に、EXT 1202という単語が含まれているすべての行を貼り付けたときに、「EXT 1202」というシートに貼り付けるよう指定することはできますが、特定の行私はそれを上書きしたくないテキストが含まれています。また、データをコピーしてペーストすると、自動的にフォントをCalibri 8に変更できますか？

私はこれはおそらく、誰かが挑戦を取り上げて、おそらく私にこのコードを教えてくれると願っています。多くのおかげで、事前に、ミシェル

Answer 1

私は一緒に投げた（いくつかの簡単なコードは、コメントが必要に応じて変更することができます）です。これは、データがSheet1のセルA2で始まり、内線番号（この例では1203/1204）がA列にあることを前提としています。行を取得して個々のシートに貼り付けます（シートを設定する必要があります）事前に）、データを持つ行をスキップします。あらかじめ定義された内線番号の1つに対応しない行は黄色で強調表示されます。お役に立てれば！

Sub Phone_Numbers() 

    'Start on the main first sheet, cell A2 
    Sheets("Sheet1").Select 
    Range("A2").Select 

    'Loop while activecell is not blank (goes down the column) 
    Do While ActiveCell <> "" 
     'You need to create these for every possible extension 
     ' Also, create individual worksheets for each 
     If InStr(1, ActiveCell, "1203", 1) <> 0 Then 
      ActiveCell.EntireRow.Copy 
      Sheets("Ext 1203").Select 
      Range("A2").Select 

     ElseIf InStr(1, ActiveCell, "1204", 1) <> 0 Then 
      ActiveCell.EntireRow.Copy 
      Sheets("Ext 1204").Select 
      Range("A2").Select 

     Else 
      'If it's not an extension you have specified, it highlites the cell 
      ActiveCell.Interior.ColorIndex = 6 
      GoTo SKIPPING 
     End If 

     Range("A2").Select 
     'Loops down until there's an open 
     Do While ActiveCell <> "" 
      ActiveCell.Offset(1, 0).Select 
     Loop 

     ActiveSheet.Paste 

     'Go back to the starting sheet & iterate to the next row 
     Sheets("Sheet1").Select 
SKIPPING: 
     ActiveCell.Offset(1, 0).Select 
    Loop 

End Sub