エクセルマクロオートフィルターで選択画面表示されている縦1列のデータを違うシートへ横3列で縦に表示

Question

シート1のA5～E5から下へ、数式が入って数値を表示しています。
オートフィルターで選択して画面に表示されている
E列のE5から下の数値をシート2へ移したいと思います。
シート2への貼り付け方は、
A1,C1,E1戻ってA3,C3,E3と、1セルづつ開けたいです。
同一シート内でオートフィルター無しで1セルづつ開けない
3列は見付けたのですが・・・どなたか教えてください。お願いします。

Sub test()
Dim I As Long
Dim C As Long
C = 1
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("Sheet1").Select
For I = 5 To Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).Row - 1 Step 3
Range("E" & I & ":E" & I + 2).Copy
Range("H" & C ).Select
Selection.PasteSpecial xlPasteValues, Transpose:=True
C = C + 1
Next I
 Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

fujillin · Accepted Answer

No7です。

＞E列の上から5番目の物が来てほしいのですが
処理の対象の始まりをE5セルからにすれば良いと思われます。

スマホからなのでテストも検証もできませんが、No7で対象セル範囲を求めているのは以下の部分です。
Worksheets("Sheet1").UsedRange.Columns(5).SpecialCells(xlCellTypeVisible)

これを4行分下方にスライドするのが一番簡単な対処法ではないかと思います。
具体的には
Worksheets("Sheet1").UsedRange.Columns(5).Offset(4).SpecialCells(xlCellTypeVisible)
としておけば良さそうです。
単純に範囲をずらしているだけなので、最下部に4行分の不要セルが含まれることになってしまいますが、空白を書き写しても空白になるだけのはずですので、害はないものと推測します。

fujillin · Answer

No1です。

＞列の挿入は2回ですみますが、行の挿入は、多すぎます。シート2は表示後印刷するだけなのです。
「行の挿入は、多すぎます」の意味がよくわかりません。
繰り返しなので、いくつあっても同じはずなのですが・・・

どうやらフィルターで選別されたセルだけをコピペしたいということらしいと、遅まきながら気が付きました。
ご提示のコードはフィルターとは無関係にコピペしているので、てっきりその内容で良いものとばかり思ってしまいました。

ご提示のコードの様にセル範囲のコピペなどで範囲をまとめて処理する方法と、一つ一つ値を代入してゆく方法などいくつか考えてみましたが、結局、単純な後者の方法が一番簡明かと思います。

すでに、No5様が同様の回答をなさっていますので、ご参考程度に。
＞シート2は表示後印刷するだけなのです
とのことですので、シート2は最初に全体をクリアしています。

Sub Sample()
Dim dr, c
Set dr = Worksheets("sheet2").Cells(1, 1)
dr.Worksheet.Cells.Clear

For Each c In Worksheets("Sheet1").UsedRange.Columns(5).SpecialCells(xlCellTypeVisible)
　dr.Value = c.Value
　Set dr = dr.Offset(, 2)
　If dr.Column > 5 Then Set dr = dr.Offset(2, -6)
Next c

End Sub

めぐみん_ · Answer

No.5です。

ちょっと検証不足でした。

めぐみん_ · Answer

Sub megu()
Dim r1 As Range, r2 As Range
Dim i As Long, cnt As Long, n As Integer

With Worksheets("Sheet1")
Set r1 = .Range("E5", .Cells(Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible)
End With

Set r2 = Worksheets("Sheet2").Range("A1")

cnt = Int(r1.Cells.Count / 3) * 3
n = r1.Cells.Count Mod 3

For i = 1 To cnt Step 3

r2.Range("A1").Value = r1.Cells(i).Value
r2.Range("C1").Value = r1.Cells(i + 1).Value
r2.Range("E1").Value = r1.Cells(i + 2).Value

Set r2 = r2.Offset(2)
Next

If n <> 0 Then

If n = 1 Then
r2.Range("A1").Value = r1.Cells(i).Value
ElseIf n = 2 Then
r2.Range("A1").Value = r1.Cells(i).Value
r2.Range("C1").Value = r1.Cells(i + 1).Value
End If

End If

Set r1 = Nothing
Set r2 = Nothing
End Sub

こんな感じですかね？
ちなみにフィルタがかかった状態で実行と言う事になってます。

めぐみん_ · Answer

No.3です。

あ”、Ｅ列だけって事なのかな？
どの道『可視セル』であるかどうかを調べながら１こずつ代入していく位しか思いつかないですね。
或いは先に『可視セル』の集団を作りって感じなのか。

めぐみん_ · Answer

No.2です。
老眼でよく読み切れなかったみたいですいません。

でもＡ５～Ｅ５を下まで（フィルタで可視セルになっている部分）を

＞A1,C1,E1戻ってA3,C3,E3と、1セルづつ開けたいです

とはどういう意味なのでしょう？
貼り付ける際にって事であれば A1,C1,E1 とはどちらのシート（多分シート２とは思いますけど）を指しているのか？
そして仮にその想定があっていたとしたら、シート１のＡ５～Ｅ５×可視セルの行数　のどのデータをどこにって思えますよ。

コピペで値貼り付けの行列変更って部分はこの場合可能なのかと疑問はありますし・・・

めぐみん_ · Answer

値であればともかく『数式』ですと、オートフィルタで抽出された式がどのセルを参照しているのか分析が必要なのではないのかな？
まして別のシートに持っていくなら『どこのシートを参照するのか？』も追加になりそう。

と、初級者は考えちゃいました。（心配のし過ぎでしたらスル～してください）

fujillin · Answer

こんにちは

＞同一シート内でオートフィルター無しで1セルづつ開けない
＞3列は見付けたのですが・
一旦、3列にしてから、一列ずつA列、C列、Ｅ列にコピペすれば、結果的に、1列おきの3列にペーストできると思いますけれど？

あるいは、シートの2の状態にもよりますが、直接シート2のA～C列に貼り付けた後、B列、C列に対して「列の挿入」を行っても同様の結果になるでしょう。

目的のセルへ直接代入しなければならないような場合は、セル範囲を纏めてのコピペは無理なので、1セルずつのループにすればよいでしょう。
（ご例示のコードのSTEP3をSTEP1にするイメージ）
セル範囲のコピペに比べると若干は時間が掛かるはずですが、行数がものすごくない限り、感覚的にはわからない程度の差だと思います。

エクセルマクロ オートフィルターで選択画面表示されている縦1列のデータを違うシートへ横3列で縦に表示

No7です。

No1です。

No.5です。

Sub megu()

No.3です。

No.2です。

値であればともかく『数式』ですと、オートフィルタで抽出された式がどのセルを参照しているのか分析が必要なのではないのかな？

こんにちは

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

エクセルマクロオートフィルターで選択画面表示されている縦1列のデータを違うシートへ横3列で縦に表示