Excelのマクロに関する質問です。良い回答は、200～800ポイント差し上げます。

これがお勧めです

Sub main()

'マスターファイルシートの開始位置

s1 = 1

'[大型]シートのセル指定 例 A列 2行目から

s2 = "A"

r2 = 2

'[小型]シートのセル指定 例 A列 5行目から

s3 = "A"

r3 = 5

'[機器]シートのセル指定 例 A列 2行目から

s4 = "A"

r4 = 2

If Worksheets("マスターファイル").Cells(4, s1) = "" Then End

For a = 4 To Worksheets("マスターファイル").Cells(4, s1).End(xlDown).Row

If Not Worksheets("マスターファイル").Rows(a).Hidden Then

If Worksheets("マスターファイル").Cells(a, s1 + 2) = "大型" Then

Worksheets("大型").Cells(r2, s2) = Worksheets("マスターファイル").Cells(a, s1)

r2 = r2 + 1

End If

If Worksheets("マスターファイル").Cells(a, s1 + 2) = "小型" Then

Worksheets("小型").Cells(r3, s3) = Worksheets("マスターファイル").Cells(a, s1)

r3 = r3 + 1

End If

If Worksheets("マスターファイル").Cells(a, s1 + 3) = "機器" Then

Worksheets("機器").Cells(r4, s4) = Worksheets("マスターファイル").Cells(a, s1)

r4 = r4 + 1

です

作成したいシートは、本当に「大型」「小型」「機器」だけなのでしょうか。

[種類]・[科目]に応じて自動でシート名を作成する例です。

実行すると追記するようにしていますが、シートを再作成したい場合は

Const appendMode = False

に変更してください。

 '//--------------------------------------------------------
 '// 処理：データを種類ごとにシートに分類
 '//--------------------------------------------------------
 '// 処理するファイル内にマクロを置いて実行してください。
 '//--------------------------------------------------------
 Option Explicit

 '//--------------------------------------------------------
 '// ファイルに併せて設定
 '//--------------------------------------------------------
 Const masterSheetName = "マスターファイル"   '--- 元データシート名
 Const dataStartLine = 4         '---  各シートのデータ開始行（ヘッダ行＋１）
 
 '//-------------------------
 '// 追記モードの指定
 '// True ・・・ データを追記    ★注意：2回実行すると同じものが追加されます
 '// False ・・・ データ再登録   ★注意：Master シート以外をすべて再作成します
  Const appendMode = True

 '//--------------------------------------------------------
 Sub 種別分類()
 '//--------------------------------------------------------
    Dim i&, lastRow
    Dim dstWB As Workbook
    Dim ws As Worksheet

    '//--- 開始処理
    Application.ScreenUpdating = False

    Dim r As Range
    With ThisWorkbook.Worksheets(masterSheetName)
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        If appendMode = False Then
            If MsgBox(masterSheetName & "以外を再作成します。よろしいですか？", vbYesNo) = vbNo Then
                Exit Sub
            End If
            Application.DisplayAlerts = False
            For Each ws In ThisWorkbook.Worksheets
                If ws.Name <> masterSheetName Then
                    ws.Delete
                End If
            Next
            Application.DisplayAlerts = True
        End If

        Set dstWB = ThisWorkbook
        For Each r In Range("C4").Resize(lastRow, 1).SpecialCells(xlVisible)
           If .Cells(r.Row, "C").Value <> "" Then
                AddLine dstWB, r.Row, "種別-" & .Cells(r.Row, "C").Value
           End If
           If .Cells(r.Row, "D").Value <> "" Then
                AddLine dstWB, r.Row, "科目-" & .Cells(r.Row, "D").Value
           End If
        Next
    End With

    '//--- 終了処理
    Application.ScreenUpdating = True

    '//--- 表示位置の調整
    For Each ws In dstWB.Worksheets
         Application.Goto Reference:=ws.Range("A1"), Scroll:=True
    Next
    dstWB.Worksheets(1).Activate
 End Sub

 '//--------------------------------------------------------
 Private Sub AddLine(dstWB As Workbook, lineNum&, sheetName$)
 '//--------------------------------------------------------
 ' コピー先シートにデータをコピー
 '---------------------------------
    Dim lastLine%

    checkAndMake dstWB, sheetName
    lastLine = dstWB.Worksheets(sheetName).Range("A" & Rows.Count).End(xlUp).Row + 1
    dstWB.Worksheets(sheetName).Cells(lastLine, "A").Value _
        = ThisWorkbook.Worksheets(masterSheetName).Cells(lineNum, "A").Value
 End Sub

 '//--------------------------------------------------------
 Private Sub checkAndMake(dstWB As Workbook, sheetName$)
 '//--------------------------------------------------------
 ' コピー先シートがあるかチェックしなければ作成
 '---------------------------------
    Dim tmpWS As Worksheet
    On Error Resume Next
    Set tmpWS = dstWB.Worksheets(sheetName)
    If tmpWS Is Nothing Then
        dstWB.Worksheets.Add After:=dstWB.Worksheets(dstWB.Worksheets.Count)
        dstWB.Worksheets(dstWB.Worksheets.Count).Name = sheetName
        dstWB.Worksheets(sheetName).Range("A1").Value = "機器"
    End If
    On Error GoTo 0
 End Sub

同様の要望はEXCELを使っている方には多いようです。

別の掲示板に回答したものですが、

http://www.excel.studio-kazu.jp/kw/20110301184111.html

を改良してみました。