○の記号のある列を抽出して別のシートにコピーをしたい

縦書きで添付画像のような年表を作成しました。
この表の４行目の○印の列を抽出してシート２にコピーしたい。
どのようにしたらいいか教えて下さい。

No.4 回答者： ママチャリ 回答日時： 2016/06/05 08:48

次の操作をお試しください。

手順①③は詳しく説明していますが、それ以外の操作が分からない場合は、補足等で再質問してください。

【手順】
①○の文字を検索して、すべて選択する。
②Cntl+0で選択した列を非表示にする。
③表示されている列（いらない列）を可視セルのみ選択して削除する。
④非表示になっている列を再表示する。

【①の説明】
「検索と選択」の「検索」で検索文字に○を指定し「すべて検索」すると見つかったセルの一覧が表示されます。一番下までスクロールして、Shiftを押しながら最終行をクリックすると全て選択することができます。

【③の説明】
表示されているものを列で選択し、「検索と選択」から「条件を選択してジャンプ」で「可視セル」を指定します。その状態で、列番号の見出しの部分を右クリックして「削除」します。

No.3 回答者： rukaandkaito 回答日時： 2016/06/03 16:08

基本シートを残したまま別シートに印刷用かなにかの表示をしたいという事でしょうね

２通り思いつきますが１つはHLOOKUP関数を使った抽出
もう一つはピボットテーブルです
そのままの様式でということであればHLOOKUPになると思いますが、横向きにフィルターをかける方法を私は知りません(笑)

もっと簡単な方法があれば後続の方にお任せします

No.2 回答者： 30246kiku 回答日時： 2016/06/02 09:39

VBA で良かったですか？

ダメならスルーということで

以下を標準モジュールに記述して Samp1 を実行すると

Sheet1 を処理対象に
使用領域を求め
その下１行を作業用にして
その作業用行から４行目を相対で指定した式を埋め込んで
（式：そのセルが ○ なら 1、　じゃなかったら "" ）
式を値に変更して、1 のセルを覚える
1 のセルを覚えていたら、
そのセルの列と使用領域の交わった所を Sheet2 の A1 へコピー
覚えていたセルの値をきれいにして･･･

※ 以下、必要なら盛り込んでみてください
・Sheet2 をきれいにしてから･･･
・コピー後の Sheet2 列幅調整･･･


Public Sub Samp1()
　　Dim rng As Range
　　Const CF As String = "=IF(R[{%1}]C=""○"",1,"""")"

　　Application.ScreenUpdating = False
　　With Worksheets("Sheet1")
　　　　With .UsedRange
　　　　　　With .Rows(.Rows.Count + 1)
　　　　　　　　.FormulaR1C1 = Replace(CF, "{%1}", 4 - .Row)
　　　　　　　　.Value = .Value
　　　　　　　　On Error Resume Next
　　　　　　　　Set rng = .SpecialCells(xlCellTypeConstants)
　　　　　　　　On Error GoTo 0
　　　　　　End With
　　　　　　If (Not rng Is Nothing) Then
　　　　　　　　Intersect(rng.EntireColumn, .Cells).Copy _
　　　　　　　　　　Worksheets("Sheet2").Range("A1")
　　　　　　　　rng.ClearContents
　　　　　　End If
　　　　End With
　　End With
　　Application.ScreenUpdating = True
End Sub

No.1 回答者： takumiio 回答日時： 2016/06/02 00:00

私なら面倒くさいので、とりあえず、全く同じシートを、

Ctrlを押しながらシートをコピーします。
ちょっと見にくいですが、もし数字が漢数字なら、
とりあえず、7行目当たりに、右方向に1、2、3・・・と数字を打っておきます。
そして、○で横ソート、それ以外を削除
7行目でソート
これで○のみがあるシートが出来上がります。

一瞬vlookupも良いと思ったけど、隙間が出来るし不適当。
自作関数やマクロを使って頑張るしかないかも。
もっと得意な方へ回答を譲りたいと思います。