マクロ 抽出してコピー貼り付けしたい

このQ&Aのポイント
  • マクロを使用して、指定したシートの特定の列を抽出し、別のシートに表示させる方法について教えてください。
  • 抽出する列は、シート1のA列・B列・D列・E列・G列です。
  • シート1には関数が入っているため、データ範囲を取得する際には注意が必要です。
回答を見る
  • ベストアンサー

マクロ 抽出してコピー貼り付けしたい

 以下のような、サイトでコードをみつけました。今ひとつ、分からないことがあります。お教え下さいませんか。 やりたい元のデーターと抽出先について sheet1の元データーはA列~G列のデーターです。sheet1のA列・B列・D列・E列・G列だけを抽出して、sheet2に表示させたいのです。なお、sheet1には、関数が入っています。 以下はサイトからのものです。 実行結果(1列目と3列目を抽出) Sub 列抽出() Dim データ範囲 As Range Dim 抽出列 As Variant Dim i As Long Set データ範囲 = ActiveSheet.Range("A1").CurrentRegion  抽出列 = Array(1, 3)  Sheets.Add.Name = "抽出" For i = 0 To UBound(抽出列)  データ範囲.Columns(抽出列(i)).Copy Sheets("抽出").Range("A1").Offset(0, i) Next i End Sub

  • rr5se
  • お礼率96% (87/90)

質問者が選んだベストアンサー

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.2

>なお、sheet1には、関数が入っています。 見落としていました。 Sub 列抽出3()  Dim データ範囲 As Range  Dim 抽出列 As Variant  Dim i As Long  Set データ範囲 = Sheets("Sheet1").Range("A1").CurrentRegion  抽出列 = Array(1, 2, 4, 5, 7)  For i = 0 To UBound(抽出列)   データ範囲.Columns(抽出列(i)).Copy   Sheets("Sheet2").Range("A1").Offset(0, i).PasteSpecial Paste:=xlPasteValues  Next i End Sub

rr5se
質問者

お礼

色んな方にご迷惑おかけしています。初心者とはいえもっと質問内容を勉強してするべきですね。いつも感じているのですが、申し訳ありません。まだまだだと思いますが、今後ともよろしくお願いします。有難うございました。

その他の回答 (3)

  • masaban
  • ベストアンサー率36% (64/177)
回答No.4

モノは考えよう。プログラムにはいろいろなアプローチが可能です。 まるごと数式関数の入ったシートを新しいしーとへコピペして、いらぬ列を丸ごと列ごと消せば同じ結果にたどり着きます。  そしてエクセルにとってずっと簡単で早い動作のプログラムになるでしょう。

rr5se
質問者

お礼

その通りですね。もっと勉強します。できれば、今後ともお教え頂ければと思っております。

  • masaban
  • ベストアンサー率36% (64/177)
回答No.3

自分のしたい事が書かれ自分でコードが理解できるWEB記事をもう一度まず探し直すべきです。きっとあるはずです。  さもないとすべておんぶにだっこになりそうです。    https://kosapi.com/post-3209/ に解説が書いてあるじゃないですか。 このプログラムのコードに書かれたコマンドリストが読めぬ能力だとすると、関数についてもすべておんぶにだっこになりそうです。ゆうりょうでプログラム開発のために働いていくれるサービスを頼むべきでしょう。 コメントに私なりの解説を入れてみましょう。 A列とB列、D、E、G目を抽出し新しいシートに数式を文字としてコピペします。目的の関数や数式のコピペにはひと工夫変換のコードが必要です。たとえば全体シートを数式から文字に変換したコピペを作ってから、それに対して事例のプログラムを使うような工夫が必要です。 実行結果(A列とB列、D、E、G目を抽出)’あるシート内の左端上端から下端入力最終行までのA列とB列、D、E、G目のデータを抽出という名称の変数データに記憶します。 Sub 列抽出() ’プログラムは列抽出という名前でここから始まります。 Dim データ範囲 As Range ’データ範囲という名称でレンジ範囲をメモリする変数を一つ作ります。 Dim 抽出列 As Variant ’抽出列という名称の整数でも文字でも、実数、レンジでも、行列がたの配列変数でメモリする群を一つ作ります。「Variant型の変数は代入時に代入する値のデータ型がチェックされ、それに合うデータ型が自動的に選択される。」ので、文字列として格納されるかもしれません。ただし数式や関数には使えず認識されません。 Dim i As Long ’このVBで最大桁の整数までメモリ可能な変数をiという名称で一つ作ります。 Set データ範囲 = ActiveSheet.Range("A1").CurrentRegion ’最初に左端の最上部のセルA1から始まる連続したデータの固まりをデータ範囲という名称のレンジにさせます。  抽出列 = Array(1,2,4,5,7) ’Array(1, 3)を応用して、 抽出列という名称の配列変数へその行のA列とB列、D、E、Gのデータを格納します。但し関数は文字として入るはずです。上手く文字として入らなかったらワンステップ工夫して下さい。  Sheets.Add.Name = "抽出" ’新しいシートを抽出という名称でエクセルのタブに表示してシートを作成します。 For i = 0 To UBound(抽出列)データ範囲.Columns(抽出列(i)).Copy Sheets("抽出").Range("A1").Offset(0, i) ’ Next i ’ i=0から抽出列という配列の最大値(最下行)の行までに繰り返して、アクティブシート内のi行A列とB列、D、E、Gをさっき作った抽出という名称のシートの左端最上行のセル(A1)から書き写し、順繰りオフセットした右列に書き込みアクティブシートの次の行でまた繰り返す。 ’写した後、まだ数式が文字としてしかエクセルには認識されていません。そこで該当する範囲を選択してから「編集」「置換」で検索する文字列「=」置換後の文字列「=」で置換する。このようなコードを作る必要があります。 End Sub

rr5se
質問者

お礼

ご協力ありがとうございました。何かふさわしい本があればお教え下さいませんでしょうか。そのことも勉強の一環なのでしようが、申し訳ありません。

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

Sub 列抽出2()  Dim データ範囲 As Range  Dim 抽出列 As Variant  Dim i As Long  Set データ範囲 = Sheets("Sheet1").Range("A1").CurrentRegion  抽出列 = Array(1, 2, 4, 5, 7)  For i = 0 To UBound(抽出列)   データ範囲.Columns(抽出列(i)).Copy Sheets("Sheet2").Range("A1").Offset(0, i)  Next i End Sub

rr5se
質問者

お礼

有難うございました。今後ともよろしくお願いします。

関連するQ&A

  • 抽出データのコピー

    OFFICE2016 AAのシートのA列を1件ずつ参照し、BBのシートでそれぞれに対応するデータを抽出し、CCのシートへコピーするマクロを作成していますが、 抽出したデータをコピーした後に保存すると、容量がものすごく大きくなっています。 原因は、コピー後にCCのシートが最終行まで使用されている状態になっているから。 下記は作成途中のマクロです Sub TEST() ' Sheets("CC").Select Cells.Select Selection.ClearContents Dim i As Long i = 1 Dim M As String M = Worksheets("AA").Cells(i, 1).Value Sheets("BB").Select Worksheets("BB").Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=M Columns("A:C").SpecialCells(xlCellTypeVisible).copy Worksheets("CC").Range("B1").PasteSpecial Paste:=xlPasteAll Application.CutCopyMode = False ' Worksheets("BB").Range("A1").CurrentRegion.AutoFilter End Sub 何が原因なのでしょう? また、その解消法教えていただきたく、よろしくお願いします。

  • エクセル マクロ 抽出

    教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると 行数=値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub

  • excel 文字抽出マクロの編集についてですが・・・

    マクロで指定した文字を含むデータを抽出するマクロを 作っていたのですが、うまく作動しません。 どこが悪いか教えてください。 Sub 指定した文字データの抽出() Dim strMoji As String strMoji = InputBox("検索文字を入力してください") strMoji = "*" & strMoji & "*" Sheets("Sheet2").Activate Cells.Clear With Sheets("Sheet1") .Range("A2").AutoFilter Filde:=3, criterial:=strMoji .Range("A2").CurrentRegion.Copy _ Destination:=Sheets("Sheet2").Range("A2") .Range("A2").AutoFilter End With Sheets("Sheet2").Columns("A:D").AutoFit End Sub

  • マクロ ソートをしたいのですが、組み込めますか

    マクロの説明 1.Sub Sample7()はsheet4の列をソートするマクロです。 (単独では、このマクロでソートできる) 2.Sub sample2()はsheet4のソート以外は完成しています。 やりたいこと Sub sample2()の中にsheet4の重複データを削除したもののソートのコードを組み込みたい。 但し、組み込むとしてSub Sample7()のコードでよいのか、初心者なのでよくわかりません。 なお、Sub sample2()のマクロは途中省いています。 Sub Sample7() Sheets("sheet4").Range("A1:A1135").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes End Sub Sub sample2() Dim data As Variant 'データコピー用の使いまわし配列 Dim dic As Object Dim i As Long Set dic = CreateObject("Scripting.Dictionary") 'Sheet4~5のA列をリセット Sheets("Sheet4").Range("A2:A" & Rows.Count).ClearContents Sheets("Sheet5").Range("C3:C" & Rows.Count).ClearContents            ↓↓↓↓↓↓↓↓↓↓↓↓↓↓ 'Sheet4に重複していないデータを書き込み With Sheets("Sheet4") .Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(dic.Count).Value = Application.Transpose(dic.keys) 'Sheet4のC列をSheet5にコピー data = .Range("C2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With Sheets("Sheet5").Range("C3").Resize(UBound(data)).Value = data Set dic = Nothing End Sub

  • エクセルVBAマクロの質問です。

    マクロ初心者です。行き詰まってます。 sheet1には300件程度のデータがあります。 このデータの3列目の値を、VLOOKUPでsheet3のA1:B30範囲から参照します。そこで取得した回数分、sheet1の各行のデータをsheet2にコピーしたいんです。 そこで、コード文を作ってみましたが、マクロがうまく動きません。 すみませんが、お知恵を貸していただけないでしょうか? Dim Z as Long Dim L As Long Dim P As Long Dim Kensaku As String Dim M4 As Range Dim PRow As Long Dim i As Long Set M4 =Sheets(“sheet3”).Range(“A1:B30“) L = Sheets(“sheet1”).Range(“A1”).End(xlup).Row For Z = 1 to L-1 Kensaku = Sheets(“sheet1”).Cells(Z+1,3).Value P=Worksheetfunction.Vlookup(Kensaku,M4,2,False)    For i = 1 to P      Prow=Sheets(“sheet2”).Range("A1").End(xlDown).Row      Sheets(“sheet1”).Rows(Z+1).Copy Sheets(“sheet2”).Rows(Prow)    Nexti Next Z

  • マクロでコピー貼り付けやってみたいのですが。

    マクロの初心者です。Dim で宣言してやりたいと思っています。 既存のExcelの機能で出来ないことはないと思いますが、敢えて、マクロででないか。 やってみたいと思っています。 やりたいこと等について 1 sheet1のE2:J1109の範囲のデータをコピーしての別sheet2のE3:J1110の範囲に貼り付けたい。 2 その時に最終行を取得してコピーをするとしたら、どんなコードが必要なのか 3 最終行の取得のコードの書き方が分からない 4 ネットで下記のような(一部変更)に作ってみたが、これで良いのでしょうか、わからない。 以上のことを答えて頂けませんか。よろしくお願いします。 Sub テスト() Dim range1 As Range Set range1 = Range("E2:J1109") range1.Copy ActiveSheet.Paste Destination:=("sheet1").Range("E2:J1109") ActiveSheet.Paste Destination:=("sheet2").Range("E3:J1110") Application.CutCopyMode = False End Sub

  • エクセルVBAマクロの質問です。

    マクロ初心者です。 データ処理のマクロを作ろうとしていて、ちょっと困ってます。 (sheet1) 11 国総 1A (空きセル ) 12 化基 2I (空きセル) ・ 以下、200程度のデータ C列のデータの種類は10種類 (sheet2) 1A 2 101 102 2I 3 103 104 105 ・ ・ sheet1のC列と同じデータ C列より右側のデータ数は1から4個程度 (sheet3) データなし sheet1のデータを、sheet3にコピーする際に、各データのD列に、sheet2のC列の右側のデータを入れていきたいんです。具体的には (sheet3) 11 国総 1A 101 11 国総 1A 102 12 化基 2I 103 12 化基 2I 104 12 化基 2I 105 っていう感じです。先日、こちらのカテゴリでなく、間違えてVBAプログラムの方に質問して、「板違いですよ」と諭されながらも、ご協力いただきsheet2の件数分増やしてコピーするコードまではたどり着いたのですが、その後、どうすればD列に移せるのかで悩んでます。ちなみに、いまたどりついたコード文は以下の通りです。 一度、このコード文の続きで、sheet3のC列を条件カウントするコードを作ってみたんですが、動いてくれませんでした。 Sub Re8928577a() Dim M4 As Range Dim P As Variant ' WorksheetFunction.VLookup Dim Kensaku As String Dim L As Long Dim PRow As Long Dim i As Long Dim Z As Long   Set M4 = Sheets("Sheet2").Range("A1:B30")   L = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row '   For Z = 1 To L - 1     Kensaku = Sheets("Sheet1").Cells(Z + 1, 3).Value     P = WorksheetFunction.VLookup(Kensaku, M4, 2, False)     PRow = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row       For i = PRow + 1 To PRow + P         Sheets("Sheet1").Rows(Z + 1).Copy Sheets("Sheet3").Rows(PRow + 1).Resize(P) Next i   Next Z End Sub

  • エクセルのマクロで検索・抽出したデータを修正及び更新して元データに反映

    エクセルのマクロで検索・抽出したデータを修正及び更新して元データに反映させたい。 Sheet1に元データが行単位で入力されています。。   A   B    C    D    E F 1 日付 顧客名 契約料 担当 回収日 回収金額 2 3 | 50 Sheet2で複数条件でフィルタオプションをマクロで実行し結果を表示ています。   A    B    C   D    E 1 日付~ 日付マデ 顧客名 担当者 2 1/1   2/28     高橋      --------->検索条件 3 4 日付 顧客名 担当 回収日 回収金額 5 -------------------------------------->抽出結果 6 -------------------------------------->抽出結果 7 -------------------------------------->抽出結果 マクロは下記の通りです。 Public Sub 検索() Dim myRow1 As Long, myRow2 As Long '----Sheet1とSheet2のA列で最終行を捜します。 myRow1 = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row myRow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row '----Sheet2のA5以下が入力されていたらクリアします。 If myRow2 >= 5 Then Sheets("Sheet2").Range("A5:P" & myRow2).ClearContents End If '----フィルタオプションの設定で抽出します。 '----元データはSheet1、抽出条件はSheet2のA1:D2、抽出先はSheet2のA4:E4です。 Sheets("Sheet1").Range("A1:F" & myRow1).AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet2").Range("A1:D2"), _ CopyToRange:=Sheets("Sheet2").Range("A4:E4"), _ Unique:=False End Sub 抽出結果の各セルデータを必要に応じて変更・修正(選出結果を直に)をしそれを元データ に反映(上書き?)させるようなマクロを作成したいです。 どなたかご指導よろしくお願いいたします。 うまく説明できないので画像を添付します。

  • エクセルVBA  どうしても動きません。

    お世話になります。 なかなか上達しない超初心者です。 ↓↓ですが、Activesheetにすると動くのに、シート名を元々存在するシート”実験"に指定すると動きません(データ内容はまったく同じで、A列に色んな名前が入っていて、重複しているとC列に重複と入力します)。 2日間試行錯誤したのですが、やっぱり動かず・・・ ちなみに、Activateにするとアクティブになるし、CurrentRegionも選択できるのに なんでうごかないんでしょうか・・・ 何卒ご指導くださいませ。よろしくお願いいたします!!!!!! Sub Test2() With Sheets("実験").Range("A1").CurrentRegion Dim i As Long Dim LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row For i = 1 To LastRow If WorksheetFunction.CountIf(Range("A:A"), Cells(i, 1)) > 1 Then Cells(i, 3) = "重複" End If Next i End With End Sub Sheets("実験")をActivesheetに変えると別のシートがしっかり動いてくれます・・・が、なんとしてでも”実験”シートに動いていただきたいです・・・。

  • Excelマクロ 複数条件一致データの抽出方法

    お世話になります。 2個の条件に一致するものを別シートに抽出したいのですが、お知恵を貸してください。 Excelシートで下記のような表があります。 これをL列(品名)かつS列(品質)の条件に一致するデータで新しいシートを作成したいのですが、 その際に新しいシート名は"AA1"のようにしたいのです。 条件がC列(品名)だけであれば下記で動いたのですが…。 (データ) A列 入荷日 I列  品目コード L列 品名 S列 品質 V列 在庫 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 1/1・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・20 2/2・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・10 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 2/3・・・・01・・・・・・・BB・・・・・・・・1・・・・・・・・・10 ※以下、最大100品目の行数10000程です。  ↓↓ (実行後希望) シート名 AA1 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 1/1・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・20 2/2・・・・01・・・・・・・AA・・・・・・・・1・・・・・・・・・10 シート名 AA2 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 2/3・・・・01・・・・・・・AA・・・・・・・・2・・・・・・・・・10 シート名 BB1 A・・・・・・I・・・・・・・・・L・・・・・・・・・S・・・・・・・・・V 2/3・・・・01・・・・・・・BB・・・・・・・・1・・・・・・・・・10 Sub Sheet抽出() Dim i As Long, Lstrow As Long, myName As String Dim MySht As Worksheet, myFlg As Boolean Application.ScreenUpdating = False With Sheets("sheet1") '準備 For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row myName = .Cells(i, 9) 'シートの存在確認 For Each MySht In Worksheets If MySht.Name = myName Then myFlg = True '既にシート在り!! Sheets(myName).Range("a1") _ .CurrentRegion.Offset(1).ClearContents Exit For End If Next '新規シートの追加 If myFlg = False Then Worksheets.Add.Name = myName End If With Sheets(myName) .Range("A1") = "入荷日" .Range("I1") = "品名コード" .Range("L1") = "品名" .Range("S1") = "品質" .Range("V1") = "在庫" End With myFlg = False Next 'データの転記 For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row myName = .Cells(i, 9).Value .Range("A" & i & ":V" & i).Copy _ Sheets(myName).Cells(Rows.Count, 1).End(xlUp).Offset(1) With Sheets(myName) .Activate Lstrow = .Cells(Rows.Count, 1).End(xlUp).Row .Cells(Rows.Count, 1).End(xlUp).Offset(1, 21) = "" .Cells(Rows.Count, 1).End(xlUp).Offset(1, 21) = _ "=SUM(v2:V" & Lstrow & ")" End With Next End With Sheets("Sheet1").Activate Application.ScreenUpdating = True End Sub 実行後希望のように抽出するには、どうすれば良いのでしょうか? よろしくお願いいたします。