Excel 2007、1列の値に基づいて1つのシートから別のシートに行をコピーする

Question

選択した行が1つのセルの値に基づいている行の範囲をコピーしようとしています。セルに同じ値を含む行を作成し、次の値に移動して最初のリストの最後に追加します。

以下は私が達成したいことを説明する私の試みです。うまくいけば上のことが私のジレンマをもっと説明するのに役立ちます。私はこれを見回してきたが、私が望むものはそれほど見つからなかった。私はそれが単純で、おそらくそうであると思った。

データダンプは、何千ものデータ行と18個の列があります。列P "契約"の値に基づいて、行全体を新しい単一のワークシートworkingdataにコピーしたいとします。すべてのデータがworkingdataワークシートに記載されるわけではありません。

契約番号は、C1234、c1235、c2345など

何私はコピーして、ソートされて達成した後だ、それはコピー直下その後、workingdataで、契約数はC1234がどこにあるデータのすべての行をコピーします契約がc1235であるすべての行など。

私は範囲P：Pを選択してソートできたが、役に立たないと思った。

Sheets("Data Dump").Select 
Columns("P:P").Select 
If Selection.Value = "C1234" Then 
Selection.EntireRow.copy 

私は私がしようとしているものを投稿する必要があります知っているが、それは、私はちょうどこの1ラウンド私の頭を取得するように見えることはできませんいくつかの理由で、哀れになります。

ここに私の最新の取り組みだ - 私はエラーがある

Dim oWorksheet As Excel.Worksheet 
Dim oRangeSource As Excel.Range 
Dim oRangeDest As Excel.Range 

Set oWorksheet = Worksheets("DataDump") 
Set oRangeSource = oWorksheet.Range("p:p") 
Set oRangeDest = Worksheets("workingdata") 

If oRangeSource="CA0004000" Then Select.EntireRow 

Selection.EntireRow.copy 
Sheets("workingdata").Select.Paste 
End If 

最新の努力を知っているが、データの並べ替えや不要なのを取り除くしない、私は対象手動フィルタをしなければならないと、ソートされ敗北の種類マクロ

Sub copy() 
' 
' copy Macro 
' 
Dim rngContracts As Range:  Set rngContracts = Sheets("DataDump").Range("P:P") 
Dim wsData As Worksheet 

Dim wsFound As Boolean: wsFound = False 
Dim ws As Worksheet 
For Each ws In ThisWorkbook.Worksheets 
    If ws.Name = "Working Data" Then 
     Set wsData = ws 
     wsFound = True 
     Exit For 
    End If 
Next ws 

If wsFound = False Then 
    Application.CutCopyMode = False 
    ActiveSheet.Range("A1").EntireRow.copy 
    Set wsData = Sheets.Add(After:=Sheets(Sheets.Count)) 
    wsData.Name = "Working Data" 
    wsData.Range("A1").EntireRow.PasteSpecial xlPasteAll, Transpose:=False 
End If 

Dim iCell As Range 
For Each iCell In rngContracts 
    If iCell.EntireRow.Hidden = False Then 
     Application.CutCopyMode = False 
     iCell.EntireRow.copy 
     wsData.Range("P" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.PasteSpecial xlPasteAll, Transpose:=False 
    End If 
Next iCell 

Application.CutCopyMode = False 
Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

End Sub 

最新attaempt - 私は必要がありますが、ソートないコピーデータ：

Sub copytest() 
' 
' copytest Macro 
' 
Set MR = Sheets("data Dump").Range("P:P") 

    For Each cell In MR 

If cell.Value = "CA000154" Then 
cell.EntireRow.copy 
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial 

    End If 

If cell.Value = "CA000220" Then 
cell.EntireRow.copy 
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial 
    End If 
If cell.Value = "CA000393" Then 
cell.EntireRow.copy 
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial 
    End If 
If cell.Value = "CA000429" Then 
cell.EntireRow.copy 
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial 
    End If 
Application.CutCopyMode = False 

Next 

End Sub 

Answer 1

データをフィルタリングするマクロを記録して、1つのフィルタのみを選択します。

次に、コードを編集し、可視範囲をシートにコピーする各フィルタをループします。これは、フィルタが既にソートされているので、データをソートする必要があります。

また、Excel VBAヘルプでフィルタ配列を使用して並べ替える方法についても見てみましょう。