web-dev-qa-db-ja.com

VBAを使用してフィルターされたデータを別のシートにコピーする

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

データシートの名前：Data
フィルターされたシートの名前：Hoky

簡単にするために、データのごく一部を取り上げています。私の目的は、フィルターに基づいて、データシートからデータをコピーすることです。なんとか機能するマクロがありますが、ハードコーディングされており、記録されています。

私の問題は：

  1. 行数は毎回異なります。 （手作業）
  2. 列が正しくありません。

enter image description hereenter image description here

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
excelvbaexcel-vbafiltercopy
2
Ananya Pandey

フィルターされたテーブルからデータをコピーする必要があるときは、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
0
Marek

別の方法で行うことをお勧めします。

次のコードでは、Rangeとしてスポーツ名Fの列と 各セルをループ として設定し、「ホッケー」であるかどうかを確認し、「はい」の場合は値を挿入します オフセット を使用して、他のシートで1つずつ。

それほど複雑ではないと思います。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
0
Rémi