お世話になります。
VBA初心者です、よろしくお願いいたします。
掲題にありますとおり、他のシートの特定の列を検索(抽出?)しアクティブになっているシートの特定の列に貼り付ける作業を自動で行わせたいと思っております。複数ある行の中から必要な行だけを抽出して、貼り付けるのでフォーマットを整えると思っていただければ結構です。具体的には、
[Sheet1]のデータ↓( | ←は罫線と思ってください。列の順番は毎回A→Zの順番とは限りませんが、記載内容は同じです。)
A | B | C | D | E … | Z
1 | 2 | 3 | 4 | 5 … |26
a | b | c | d | e … | z
1a| 2b| 3c| 4d| 5e… |26z
これらのデータから、特定の必要な列を選んで[Sheet2]に貼り付けを自動で行わせたいのです↓。
[Sheet2]B,G,A,W,O,Iのデータのみ必要な場合
B | G | A | W | O | I
2 | 7 | 1 | 23| 15| 9
b | g | a | w | o | i
2b| 7g| 1a|23w|15o| 9i
行数は最大で500行を超えます。HLOOKUPを各セルに書き込んで置けばよいのですが、ドッラグでは式が正しく書き込めなくて。。。
"=HLOOKUP(A1,Sheet1!A:Z,2,0)"←"A1"はA2,A3,A4となるのですが"2"がずっと2のままなので。
[Sheet1]の特定の行のコピー&ペーストなのですが、[Sheet2]の貼り付け先が1行目からではないので、何かしらの工夫が必要だと思うのですが。。。
たとえば
Columns("B:B").Select
Selection.Copy
Sheets("Sheet2").Select
Cells(2, 1).Paste
こう言う事って出来ませんよね?
私の意は伝わりましたでしょうか?なにとぞよろしくお願いいたします。
No.4
- 回答日時:
こんばんは。
>[Sheet2]のBは"C10(=10,3)"のセルから、G="D10", A="E10"…I="H10=(10,8)"と続きます。貴殿の記述ですと"A2"よりPasteが始まります。
私の場合は、* を書き換えればよいはずです。
なお、私の書いていたものは、
>Row1(1行目)には全てデータが入っております。
ということではなく、A列に入っているかどうか、ということです。
i = 3 '初期値 *
For Each c In ColLists
''補正する場合 j = Cells(1, c).Column - rng.Cells(1, 1).Column + 1
''rng.Columns(j).Copy に変える
rng.Columns(c).Copy Worksheets("Sheet2").Cells(10, i) '*
i = i + 1
Next c
それと、大勢には影響がないのですが、ルールとして忘れてました。
Next c
Set rng = Nothing '←は、書き加えてください。*
End Sub
Wendy02さん、
こんばんは。出来ましたよ!本当にどうもありがとうございました。
とってもシンプルで処理が早いです。どうすれば貴殿のようになれるのでしょう。。。自己紹介を読ませていただきましたが、どうやら趣味のようで。。。地道に勉強して行こうと思っております。また機会がございましたら、よろしくお願い申し上げます。
No.3ベストアンサー
- 回答日時:
こんなのではどうでしょうか?
Sub sample()
'初期設定(コピー元とコピー先のシート、コピーする列を設定)
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim copyColumns As String
Set srcSheet = Sheets("Sheet1")
Set dstSheet = Sheets("Sheet2")
copyColumns = "B,G,A,W,O,I"
'
Dim srcRowTop As Long
Dim srcRowBottom As Long
Dim dstRowTop As Long
Dim dstColumnLeft As Integer
Dim cols() As String
Dim i As Integer
'コピー元の最初と最後の行を取得(有効なデータ行は、A列には必ずデータがあるとします)
srcRowTop = 1
srcRowBottom = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row 'A列の最後のデータの行
If (srcRowBottom = 1) And (srcSheet.Cells(1, 1) = "") Then '最後の行が1行目で、実は1行目にデータが無い場合
Exit Sub 'コピー元データなし
End If
'コピー先の最初の行を設定
dstRowTop = 10 'C10の10
dstColumnLeft = 3 'C10のC(=3)
'コピーする列名を配列へ取得
cols = Split(copyColumns, ",")
'コピー開始
For i = 0 To UBound(cols)
srcSheet.Range(cols(i) & srcRowTop & ":" & cols(i) & srcRowBottom).Copy Destination:=dstSheet.Cells(dstRowTop, i + dstColumnLeft)
Next
End Sub
ちなみに、コピー先が変わったら
'コピー先の最初の行を設定
dstRowTop = 10 'C10の10
dstColumnLeft = 3 'C10のC(=3)
の部分を変更してください。
出来ました!C10から張り付いてくれました。
A,B,C…を貼り付ける部分のセルの色が白になってしまうので(コピー先はグレー、元は白)、「srcRowTop = 1」の1を2に変えてみたら1行目を含めずその下の部分をコピーして貼り付けてくれました。親切なDescriptionのおかげです。本当にありがとうございました。
また機会がございましたら、よろしくお願い申し上げます。
No.2
- 回答日時:
こんにちは。
あまり、難しく考える必要はないと思います。
ただ、注意としては、基本的な考え方としては、範囲(rng)に対する列の列数で、厳密にいうと、A,B,Cという列数というワークシートの列ではありませんが、それさえ、気をつければ、以下のような簡単なコードで済みます。
B列からデータが始まれば、B列が、1列目, C列が、2列目になります。
つまり、Sheet1 のA列からデータがないと、補正しなくてはならない、ということになります。
言い換えると、論理的な列数で、物理的な列名とは違います。
例:データがA列から始まらないばあは、補正します。
列数(j) = Cells(1, c).Column - rng.Cells(1, 1).Column + 1
'------------------------------------------
Sub Test1()
Dim ColLists As Variant
Dim c As Variant
Dim i As Integer
'Dim j As Integer A列からデータばない時、補正が必要
Dim rng As Range
Const COLLIST As String = "B,G,A,W,O,I"
ColLists = Split(COLLIST, ",")
'データ範囲
Set rng = Worksheets("Sheet1").Range("A1").CurrentRegion
i = 1 '初期値
For Each c In ColLists
''補正する場合 j = Cells(1, c).Column - rng.Cells(1, 1).Column + 1
''rng.Columns(j).Copy に変える
rng.Columns(c).Copy Worksheets("Sheet2").Cells(2, i)
i = i + 1
Next c
End Sub
Wendy02さん
早速のご指導ありがとうございます。前回お書きいたしましたとおり、私は全くの初心者でございまして、双方とも試させていただきましたが、もう少しの微調整が出来ずにおります。[Sheet1]の"A"はA1にありB1>C1…Z1と続きます。Row1(1行目)には全てデータが入っております。コピー先の
[Sheet2]のBは"C10(=10,3)"のセルから、G="D10", A="E10"…I="H10=(10,8)"と続きます。貴殿の記述ですと"A2"よりPasteが始まります。
どのように書き換えればよろしいのでしょうか?勝手言って申し訳ございませんが、なにとぞよろしくお願いいたします。
No.1
- 回答日時:
こんなのではどうでしょうか?
Sub sample()
'初期設定(コピー元とコピー先のシート、コピーする列を設定)
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim copyColumns As String
Set srcSheet = Sheets("Sheet1")
Set dstSheet = Sheets("Sheet2")
copyColumns = "B,G,A,W,O,I"
'
Dim srcRowTop As Long
Dim srcRowBottom As Long
Dim dstRowTop As Long
Dim cols() As String
Dim i As Integer
'コピー元の最初と最後の行を取得(有効なデータ行は、A列には必ずデータがあるとします)
srcRowTop = 1
srcRowBottom = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row 'A列の最後のデータの行
If (srcRowBottom = 1) And (srcSheet.Cells(1, 1) = "") Then '最後の行が1行目で、実は1行目にデータが無い場合
Exit Sub 'コピー元データなし
End If
'コピー先の最初の行を取得(有効なデータ行は、A列には必ずデータがあるとします)
dstRowTop = dstSheet.Cells(dstSheet.Rows.Count, 1).End(xlUp).Row + 1 'A列の最後のデータの行+1
If (dstRowTop = 2) And (dstSheet.Cells(1, 1) = "") Then '最初の行が2行目で、実は1行目にデータが無い場合
dstRowTop = 1 'コピー先データなし(コピー先は先頭行から)
End If
'コピーする列名を配列へ取得
cols = Split(copyColumns, ",")
'コピー開始
For i = 0 To UBound(cols)
srcSheet.Range(cols(i) & srcRowTop & ":" & cols(i) & srcRowBottom).Copy Destination:=dstSheet.Cells(dstRowTop, i + 1)
Next
End Sub
fumufumu_2006さん,
早速のご指導ありがとうございます。前回お書きいたしましたとおり、私は全くの初心者でございまして、双方とも試させていただきましたが、もう少しの微調整が出来ずにおります。[Sheet1]の"A"はA1にありB1>C1…Z1と続きます。Row1(1行目)には全てデータが入っております。コピー先の
[Sheet2]のBは"C10(=10,3)"のセルから、G="D10", A="E10"…I="H10=(10,8)"と続きます。貴殿の記述ですと"A1"からpasteが始まります。
どのように書き換えればよろしいのでしょうか?勝手言って申し訳ございませんが、なにとぞよろしくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルのマクロでコピー後の貼り付け先を毎回指定したところにしたい 5 2022/08/12 10:47
- Visual Basic(VBA) 改行ごとに行を追加し、数量を分割 4 2023/07/11 16:39
- Visual Basic(VBA) Excel(VBA) 特定の条件に該当する行の値、書式を同じセルにコピ&ペーストしたいです 1 2022/05/21 18:18
- Visual Basic(VBA) vbaエクセルマクロ RemoveDuplicatesについて RemoveDuplicatesを使 3 2023/02/28 01:13
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Excel(エクセル) VBA セルの値と同じ名前のシートにデータを貼り付けするやり方を教えてください 2 2022/05/17 16:26
- Excel(エクセル) シートが違う2枚のエクセルシートにある数値を別シートにコピーしたい(VBA?) 8 2022/03/31 12:24
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
- Visual Basic(VBA) 集計シートA列のコードと一致する右に並んだシート名(コード)の3行目から10行目をコピーして貼り付け 4 2022/08/18 15:24
- Visual Basic(VBA) Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。 3 2023/05/11 13:14
このQ&Aを見た人はこんなQ&Aも見ています
-
外出時に「待たせる妻」vs イライラする「待つ夫」は日本だけ?見習いたい海外事情
夫の家事参加に積極的なイメージのある海外でも、同様の事例はあるのか。結婚カウンセラーの佐竹悦子さんに伺ってみた。
-
エクセルVBAで、ある文字を含んでいたら別シートに抽出したい
Excel(エクセル)
-
【VBA】特定の値が入った行をコピーして別シートに貼り付ける方法をおしえていただきたいです。
Excel(エクセル)
-
VBAを使って検索したセルをコピーして別の場所に貼り付ける。
Visual Basic(VBA)
-
-
4
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
-
5
excel2010 マクロで複数シート検索し、一致した行をコピーしたい
Excel(エクセル)
-
6
VBAで検索して、行をコピー&追加したい
Excel(エクセル)
-
7
EXCEL VBAで複数シートから該当列のみを別シート列方向に順番に貼り付け
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【Excel VBA】CSV取込時、数字...
-
EXCELの列の幅
-
Word2016でExcelデータを差込し...
-
エクセルで電話番号にハイフン...
-
可視セルのみのコピー
-
Excelでの在庫管理
-
EXCELで不良率を出そうと思って...
-
順位表において先週と今週の数...
-
Excelで複数セルを選択したまま...
-
エクセルシートの選択範囲をコ...
-
VBAで列に計算式を入れたい
-
【Excel VBA】データの最終行に...
-
EXCELで2つのシートから一致し...
-
セル入力文字が、「右のセルに...
-
ワードの文章囲み枠(?)を消...
-
パワポの複数ページにまたがる...
-
ワードで勝手に点線ラインがでる
-
エクセル、ページをまたがった...
-
wordで罫線が引けない・・・
-
エクセルでセルの中の文字が削...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Word2016でExcelデータを差込し...
-
【Excel VBA】CSV取込時、数字...
-
EXCELで2つのシートから一致し...
-
Excel 表の必要箇所だけを抜き...
-
EXCELの列の幅
-
エクセルで前年同日・前月同日...
-
エクセルでページ毎の計をつけ...
-
EXCEL2007で2つのシートのどっ...
-
excelの列がいっぱいになり列を...
-
エクセルで電話番号にハイフン...
-
エクセルVBAで複数列データを1...
-
EXCELで不良率を出そうと思って...
-
エクセルの複数ワークシートの...
-
エクセルの余白を0にしても列...
-
エクセルで縦線のいっぱい入っ...
-
Excelで奇数行を削除
-
ExcelのIF関数について
-
Excelのhperlink関数で作ったモ...
-
エクセル:最新データ12件で...
-
ピボットテーブル作成後、重複...
おすすめ情報