>>247 Sub Sample() Dim K_Ban As Long: K_Ban = Worksheets("メイン画面").Range("B5") Dim r As Long Dim shubetsu As String Dim shubetsuCnt As Integer With ThisWorkbook.Sheets("情報Ｂ") .Range(.Cells(1, 1), .Cells(.Rows.Count, 4).End(xlUp)).AutoFilter Field:=1, Criteria1:=K_Ban r = 2 Do While .Cells(r, 1) <> "" If .Rows(r).Hidden = False Then If shubetsu <> .Cells(r, 2) Then shubetsu = .Cells(r, 2) shubetsuCnt = 1 ElseIf shubetsuCnt < 3 Then shubetsuCnt = shubetsuCnt + 1 Else .Rows(r).Hidden = True End If End If r = r + 1 Loop .Range(.Cells(2, 1), .Cells(.Rows.Count, 4).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _ Destination:=ThisWorkbook.Sheets("メイン画面").Cells(8, 3) '←任意のコピー先セル .AutoFilterMode = False End With End Sub
