列コピーについて

質問

VBAを利用した複数必要列をコピーする方法を教えて下さい。

シート1に入っているデータで
1行目には、項目名が入っています。
項目数はMAX200個前後です。

毎月各担当者からデータが入ったExcelブックを受け取り
必要な列だけを残して、データをコピペして頑張っていたのですが、
毎回列並びが異なるのと、担当者によっては抽出してくる
項目が違うため担当者ごとに修正するのが手まで困っております。

作業を以下の様にしたいです。

各ブックに入っている項目数はバラバラですが、最終的に必要な項目は
各担当者で必ず残してもらえています。
但し各担当者によって列並びがバラバラで困っています。

(1)例えばシート１に以下の様にデータを入力しておく　（担当者で）
A B（列）
(行）
1 test
2 支店
3 営業担当者
4 番号

(2)シート2は各担当者より提出されるデータをまるっと貼り付ける
A B（列）
(行）test 日付 支店 営業担当者 エリア 番号 住所 電話番号
1
2 2行目以降はデータだけが入っている
3
4

★行いたいのは(2)に入っているデータより★
(1)に入力されているB列の2行目以降に入っている項目キーと一致するデータを
(2)からコピーしてシート3へ必要な項目が入っているデータを列ごと貼り付けたい

最終イメージーはにシート2に入っているデータから、
シート1には入っている項目だけのデータを
シート2からコピーしたデータだけがシート3に残るようにしたいです。
以下がシート3で最終的に残るデータとしたい
A（列） 　　B（列）　C（列）　D（列）　E（列）　F（列）　→　以降項目数が続く
(行）test 　支店　　　営業　　　担当者　番号　　　 電話番号
1
2 2行目以降はデータだけが入っている
3
4
↓　以降　データが入っている

必要データ以外は削除としたのですが、
項目数が多く以下の内容ではうまくいきませんでした。

※例として書いているのが項目名が4つとしていますが、
必要な項目数はおよそ30前後になります。下記の内容では、
文字数の関係でエラーが出た為必要な項目をコピーして別シートへ貼り付ける方が
よいとアドバイスをいただいたのですがうまく書けませんでした。

Dim rng As Range
Set rng = Cells.Find("test、支店、営業担当者、番号", , xlValues, xlWhole)
If Not rng Is Nothing Then
Range(rng.Offset.EntireColumn, rng.Address).Delete
End If
Set rng = Nothing

どのようにすれば必要な項目を列ごとコピーして別シートへ貼り付けることができるでしょうか。
是非お力添えをお願い致します。

回答No.8

HohoPapa

>仰る通り各担当者からのは添付データのようなイメージです。
ならば、
このイメージのシートが１枚目に無い
といったオチはありませんか？

マクロは、このイメージのシートが１枚目である必要があります。

補足

遅くに申し訳ございません。
イメージシートは1枚目の認識です。
念の為に手順をお伺いしてもよろしいでしょうか。

回答No.7

HohoPapa

当方は、
編集元のエクセルファイルが添付のようなデータとイメージしています。
編集元のエクセルファイルがどのようなデータなのか教えてください。

列名が1行目に埋まっているんですよね？
途中に列名が空欄のセルがありますか？

お礼

返答が遅くなり申し訳ございませんでした。

補足

ご連絡ありがとうございます。
残業で今帰宅し今確認しました。

仰る通り各担当者からのは添付データのようなイメージです。
新規ブックシート1のB列でもどこでもよいのですが、
縦に必要項目名を羅列します。

そしてシート2では、各担当者から受け取るデータを全部は率えます。
列の途中に空白などもありません。

最後に、シート1にある項目名だけが、シート2から列ごとコピーし
シート3などに貼り付け最終的に残ったデータはシート1と
項目名が一致したデータとなります。

回答No.6

山田 太郎（@f_a_007）

＞マクロでエラーが出て作業がストップ！

　えっ。で、試したら、こっちもエラーが出ました。で、これは、回避不能のエラーですね。で、対策は、ただ一つです。相手を変えることは不能。だったら、こっちが変わるだけですね。

現行：SheetCopy("SELECT N番目迄 FROM XXXX", "SheetXXX")
対策：コピーの仕方にオプションを設ける。

　　　SheetCopy("SELECT N番目迄 FROM XXXX", "SheetXXX", 0)
　　　SheetCopy("SELECT N番目迄 FROM XXXX", "SheetXXX", 1)
　　　SheetCopy("SELECT N番目迄 FROM XXXX", "SheetXXX", 2)

0：シートをクリアして書き込む。
1：既存シートの列の後に追加する。
2：既存シートの行の後に追加する。

　まあ、列の使用MAX、行の使用MAXが判れば、こんちのもんでしょうが・・・。

　まあ、VBAとしては3行ほどの追加になります。そして、書き込む位置を調節するXOffSet、YOffsetなる二つの変数をかますことになるでしょう。これしかないと思いますね。列名は、どこからどこまでは今でも指示できますので大丈夫です。

FROM [Sheet1$A1:A10]
FROM [Sheet1$A11:A20]
FROM [Sheet1$A21:A30]

で、マクロ1、2、3を順番通りに実行する。私の解決策は、こんな感じです。

回答No.5

HohoPapa

マクロブックは添付画像のように
必要な列名がＢ列の埋まっている前提です。
これにより
このマクロブックの２枚目に、
>シート2は各担当者より提出されるデータをまるっと貼り付ける
が作成され、
>シート2からコピーしたデータだけがシート3に
作成される動作になるはずなんです。

どこが期待と異なりますか？

補足

回答ありがとうございます。
頂いた内容で行うと、列がありませんとなり、データが何も残らない状態となってしまいました。当方の力不足だと思います。

回答No.4

山田 太郎（@f_a_007）

【補足】SheetCopy()について

【利用方法】

[イミディエイト ウインドウ]
？ SheetCopy("SELECT 抜き出したい列名リスト FROM [Sheet2$A1:Z10000]", "Sheet3")

　これだけです。

　なお、シート1のデータを参照して抜き出したいリストを自動生成するには

？ SheetCopy("SELECT " & DSelsct("SELECT 列名 FROM [Sheet1$A1:A1000]",",") & " FROM [Sheet2$A1:Z10000]", "Sheet3")

と書きます。

　なお、SheetCopy()で重要な働きをするのは、DSelsct()です。この手の関数の冒頭の１行を見て、どういう引数を書くのかの理解に手間取るようでしたら、同関数の利用は勧めません。

Public Function DSelect(ByVal strSQL As String, _
　　　　　　　　　　　　Optional colDelimita As String = ";", _
　　　　　　　　　　　　Optional rowDelimita As String = "|", _
　　　　　　　　　　　　Optional xlFileName As String = "", _
　　　　　　　　　　　　Optional isHeader As Boolean = True) As String

　一応、質問者のやろうとしていることが１行のマクロで達成できる環境が整ったのご案内しておきます。なお、現状では、その１行をどのように書くべきかは示せません。質問に具体的な添付図が示されていない為です。

祈、成功！

補足

正に頂いた内容にしたいのですが、うまくいかずです。

行いたいのが、

最終イメージーはシート1には入っている項目は
シート2で一致している項目のデータをだけを残し、
不要な列＝シート１の項目にないデータは列ごと削除したい

項目数が約30前後のため1行マクロではどうすることもできなく、
行を「_」でと考えてもおかしな状態となるのです。

回答No.3

HohoPapa

先の質問に返信したマクロのを加工してポストします。
よかったら参考にしてみてください。
なお、
>(1)シート1のB列などにに項目名を縦にデータを入力し一覧にする。
シート1のB列１行目から縦に列名が期待の順番に並んでいる前提です.

Option Explicit

Sub Sample()

　Dim GetFilePath As String
　Dim GetBook As Workbook
　Dim GetSheet As Worksheet
　Dim TblSheet As Worksheet
　Dim PutSheet1 As Worksheet
　Dim PutSheet2 As Worksheet
　Dim RowCouter As Long
　Dim ColCouter As Long
　Dim ColNum As Long
　Dim ColName As String

　'編集元ブックを選択して開く
　With Application.FileDialog(msoFileDialogOpen)
　　.InitialFileName = ThisWorkbook.Path
　　.Show
　　If .SelectedItems.Count = 0 Then
　　　MsgBox ("ファイルの選択がキャンセルされました。")
　　　Exit Sub
　　End If
　　GetFilePath = .SelectedItems(1)
　End With
　Set GetBook = Workbooks.Open(GetFilePath)
　Set GetSheet = GetBook.Sheets(1)
　Set TblSheet = ThisWorkbook.Sheets(1)

　'出力先シートを自ブックに追加し、編集元シートを複写
　ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(1)
　GetSheet.Copy after:=TblSheet
　Set PutSheet1 = ThisWorkbook.Sheets(2)
　Set PutSheet2 = ThisWorkbook.Sheets(3)

　RowCouter = 1　 '列並び一覧のデータ開始行

　'列ごとにコピペ
　Do
　　If TblSheet.Cells(RowCouter, 2).Value = "" Then Exit Do
　　ColName = TblSheet.Cells(RowCouter, 2).Value 'B列を順に取得
　　ColCouter = 1
　　ColNum = 0
　　Do
　　　If PutSheet1.Cells(1, ColCouter).Value = "" Then Exit Do
　　　If ColName = PutSheet1.Cells(1, ColCouter).Value Then
　　　　ColNum = ColCouter
　　　　Exit Do
　　　End If
　　　ColCouter = ColCouter + 1
　　Loop
　　If ColNum = 0 Then
　　　MsgBox ("列がありません:" & ColName)
　　Else
　　　PutSheet1.Columns(ColNum).Copy
　　　PutSheet2.Columns(RowCouter).PasteSpecial
　　End If
　　RowCouter = RowCouter + 1
　Loop

　'Application.DisplayAlerts = False
　GetBook.Close False　'編集元ブックをクローズ
　'Application.DisplayAlerts = True

End Sub

補足

回答がありがとうございます。
頂いた内容だと、新規ExcelブックでVBAのデータを書いて実行すると、
データの入ったExcelブックを指定して開いて、コピーとなるようです。

また、説明が下手で申し訳ないです。
行いたい最終データのイメージですが、
A（列） 　　B（列）　C（列）　D（列）　E（列）　F（列）　→　以降項目数が続く
(行）test 　支店　　　営業　　　担当者　番号　　　 電話番号
1
2 　　2行目以降はデータだけが入っている
3
4
↓　以降　データが入っている

シート1にB列に縦に【残したいデータの項目が入る】
シート2が各担当者から受け取るデータが入っていて、
シート2で残るのが【シート1のB列に入っている項目名と一致したもの】ですが、

シート2の項目名は
A（列） 　　B（列）　C（列）　D（列）　E（列）　F（列）
※各列の【1行目に横の行】に展開されており、
　データは1行目以降の列に入っている
1↓　以降　データが入っている
2↓　以降　データが入っている
3↓　以降　データが入っている

シート1のB列に縦に入っているデータを
シート2で項目が一致しているものだけを、【列ごとコピーしてシート3】に移す。
またはシート2でシート1に入っている【項目以外のデータをシート2から削除しシート1の項目と一致するものだけが残る】、というように実行したいのですがうまくいかず困っております。是非お知恵を貸して頂けると助かります。

回答No.2

imogasi

各担当者のシートデータをどうまとめようとしているのか伝わりにくい。
（成績的な＝）量的な、集約表を作るのか。
列的に表の体裁（＝列項目の出現）を統一したいのか。
データの列位置だけを内容的に全員分揃えるのか？
普通はA担当者のデータの行的最終行の次に、B担当者のデータを張り付ける、などでよい（ある商品の売上個数（や商品名）を累積していく）場合があると思うが、完成後A担当者のデータか、B担当者のデータかどうかは、残す必要があるのかな。
ーー
あるならどこかの列に氏名などを残せばよい。
ーー
例えば人事表などで
X氏　A,C、F項目を記入あり
Y氏　A、B、F項目を記入あり
で
ーは空白列として
X　A ーC－ーF
Y　AB－ーEー
のようなデータを作ればよいのか？
＝＝
見出しの文字列は担当者は、１字１句間違わないという前提で
VBAでFindで標準の列を見つける。
累積するなら、その列について、END(ｘｌUp)で直前までの最終行を見つけ
その直下から張り付ければ仕舞い。
　処理実行時間は多少かかっても、VBAのコード行数は少なくて済む簡単な問題。
質問文を読み解くのに苦労する。
３人分、３項目のシート模擬例で、シートデータの完成形を示すのが一番良いと思うよ。

回答No.1

山田 太郎（@f_a_007）

Q、必要な項目を別シートへコピーする方法。
A、10個ぐらい新しい私の質問を参照されたし。

　それは、質問者の希望を叶えるための仕上げの為の質問です。その添付図でも分かるように、項目を指定して、かつ、色んな条件を付けて別シートにコピーすることが可能です。ただ、A⇒H、B⇒Hを連続的に行うには、追加開始の行を指示できるように、また、見出し部の書き込みの要不要も指示できるように改変する必要があります。でも、そういう改変をしないで、Hは一時シートという位置付けをされた方が無難だと思います。

　明日までには、《緑の三角門田》は解決すると思います。で、その時は、関数一発でコピーも可能となります。イミディエイトウインドウで関数を起動するだけです。

　まあ、エクセルについては知識ゼロの私の回答。参考程度に読み流してください。