検索シートに入力した値をdataシートから検索し、該当する行の1列から27列までを入力シートの入力されている値の続きから貼り付けしたいのですが。
検索シートに入力した値をdataシートから検索し、該当する行の1列から27列までを入力シートの入力されている値の続きから貼り付けしたいのですが。 検索シートに入力するのは1行～複数になる可能性があります。 入力する箇所はA2セルからです。 dataシートには45列までデータがありますがコピーしたいのは27列までになり ます。 検索シートとdataシートは検索.xlsmにあり、入力シートは入力.xlsxにあります。 VBAはまったくわからないわけではありませんが、考えたことを具体化しようとするとなかなか難しくて… よろしくお願いします。
補足
補足なんですが、よろしければ値を取得する箇所と貼り付ける箇所を 変更するかもしれないので、取得行の1列目から20列目、22列目から27列目を取得するいった感じで21列目だけはずす式も教えていただきたいのですが、 お願いいたします。
Visual Basic | Excel・150閲覧
ベストアンサー
検索.xlsm 入れるマクロです。 入力.xlsx はどこにあるのか、どういう状態なのか（開かれた前提でマクロを実行するのか）書いていないので、検索.xlsm と同じフォルダにあって、マクロの中で開くようにしてあります。 Sub test() Dim wb As Workbook Dim sh1 As Worksheet, sh2 As Worksheet Dim sh As Worksheet Dim rng As Range Dim r1 As Long, r2 As Long Dim ck As Variant Application.ScreenUpdating = False Set sh1 = Worksheets("検索") Set sh2 = Worksheets("data") With sh2 Set rng = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row) End With Set wb = Workbooks.Open(ThisWorkbook.path & "\入力.xlsx") Set sh = wb.Worksheets(1) r2 = sh.Cells(Rows.Count, 1).End(xlUp).Row With sh1 For r1 = 1 To .Cells(Rows.Count, 1).End(xlUp).Row ck = Application.Match(.Cells(r1, 1).Value, rng, 0) If IsError(ck) = False Then r2 = r2 + 1 sh.Cells(r2, 1).Resize(, 20).Value = sh2.Cells(ck, 1).Resize(, 20).Value sh.Cells(r2, 21).Resize(, 6).Value = sh2.Cells(ck, 22).Resize(, 6).Value End If Next r1 End With wb.Close SaveChanges:=True Application.ScreenUpdating = True End Sub
複数のブックを扱う場合は、マクロはどこに入れるのか、それぞれのブックはどのフォルダに入っているのかを書いて下さい。 それによってコードが変わります。
質問者からのお礼コメント
返信が遅くなってすみません。 この通りでまったく問題ないです。 もう少し勉強してちゃんと理解できるよう頑張ります。 ありがとうございました。
お礼日時：6/30 16:47
