マクロを使用してフィルタリングされたデータを別のシートにコピー

Question

2枚のシートには完全なデータがあり、もう1枚は最初のシートに適用されたフィルタに基づいています。データシートの

名：「データ」フィルターシートの 名：「Hoky」

私は簡単にするためにデータの小さな部分を取っています。 私の目的は、フィルタに基づいて、データシートからデータをコピーすることです。 私は何らかの形で動作しますが、そのハードコードされ、記録されたマクロです。

私の問題は、 です。1.行数は毎回異なります。 （手作業） 2.列が整列していません。

以下は、このシートの[マイコード]と[スクリーンショット]です。

Sub TESTTHIS() 
' 
' TESTTHIS Macro 
' 
'FILTER 
Range("F2").Select 
Selection.AutoFilter 
ActiveSheet.Range("$B$2:$F$12").AutoFilter Field:=5, Criteria1:="hockey" 

'Data Selection and Copy 
Range("C3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 
Sheets("Hockey").Select 
Range("E3").Select 
ActiveSheet.Paste 

Sheets("Data").Select 
Range("D3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Application.CutCopyMode = False 
Selection.Copy 
Sheets("Hockey").Select 
Range("D3").Select 
ActiveSheet.Paste 

Sheets("Data").Select 
Range("E3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Application.CutCopyMode = False 
Selection.Copy 
Sheets("Hockey").Select 
Range("C3").Select 
ActiveSheet.Paste 

End Sub 

Answer 1

私はあなたがそれを別の方法を行うことをお勧めします。私はRangeスポーツ名Fとそれのloop through each cellと列として設定し、次のコードで

、それは「ホッケー」であるかどうかを確認し、はい、私はOffsetを使用することにより、他のシート一つずつに値を挿入する場合。

私はそれが非常に複雑ではないと思います。あなたがVBAを学んでいても、おそらくすべてのステップを理解できるはずです。あなたは

Sub TestThat() 

'Declare the variables 
Dim DataSh As Worksheet 
Dim HokySh As Worksheet 
Dim SportsRange As Range 
Dim rCell As Range 
Dim i As Long 

'Set the variables 
Set DataSh = ThisWorkbook.Sheets("Data") 
Set HokySh = ThisWorkbook.Sheets("Hoky") 

Set SportsRange = DataSh.Range(DataSh.Cells(3, 6), DataSh.Cells(Rows.Count, 6).End(xlUp)) 
    'I went from the cell row3/column6 (or F3) and go down until the last non empty cell 

    i = 2 

    For Each rCell In SportsRange 'loop through each cell in the range 

     If rCell = "hockey" Then 'check if the cell is equal to "hockey" 

      i = i + 1        'Row number (+1 everytime I found another "hockey") 
      HokySh.Cells(i, 2) = i - 2    'S No. 
      HokySh.Cells(i, 3) = rCell.Offset(0, -1) 'School 
      HokySh.Cells(i, 4) = rCell.Offset(0, -2) 'Background 
      HokySh.Cells(i, 5) = rCell.Offset(0, -3) 'Age 

     End If 

    Next rCell 

End Sub 

Answer 2

私は、フィルタリングテーブルからデータをコピーする必要があるとき、私はrange.SpecialCells（xlCellTypeVisible）.copyを使用しています。範囲はすべてのデータの範囲です（フィルタなし）。

例：

Sub copy() 
    'source worksheet 
    dim ws as Worksheet 
    set ws = Application.Worksheets("Data")' set you source worksheet here 
    dim data_end_row_number as Integer 
    data_end_row_number = ws.Range("B3").End(XlDown).Row.Number 
    'enable filter 
    ws.Range("B2:F2").AutoFilter Field:=2, Criteria1:="hockey", VisibleDropDown:=True 
    ws.Range("B3:F" & data_end_row_number).SpecialCells(xlCellTypeVisible).Copy 
    Application.Worksheets("Hoky").Range("B3").Paste 
    'You have to add headers to Hoky worksheet 
end sub 

Answer 3

それは

コードの下にはやっての最良の方法は、DBExtractシートに表示されるデータをコピーすることで、いくつかの明確化が必要な場合は私に知らせて、そして唯一のフィルタリングされた値で、duplicateRecordsシートに貼り付けてください。 。私が選択した範囲は、自分のデータが占めることのできる最大範囲です。必要に応じて変更することができます。

Sub selectVisibleRange() 

    Dim DbExtract, DuplicateRecords As Worksheet 
    Set DbExtract = ThisWorkbook.Sheets("Export Worksheet") 
    Set DuplicateRecords = ThisWorkbook.Sheets("DuplicateRecords") 

    DbExtract.Range("A1:BF9999").SpecialCells(xlCellTypeVisible).Copy 
    DuplicateRecords.Cells(1, 1).PasteSpecial 


    End Sub