お恥ずかしいながら、VBA初心者で、現在ものすごく困っております。 VBAでの転記について教えてください

画像

Visual Basic | Excel91閲覧

ベストアンサー

0
画像

<使い方> 1. 冒頭のConst ... のパラメーターを適宜変更 2. マクロ "転記" を実行 <マクロの流れ> 1. 指定フォルダ内のブック(.xls)を一つ一つ開く 2. 指定シートのA2:E最終行からデータを取って配列に入れる 3. ブック名と配列を連想配列に入れる 4. 連想配列からブック名と配列を取り出し、転記する

ThanksImg質問者からのお礼コメント

とても参考になりました! もうお一人の方のコードも勉強させて頂いております。 未だコード等の動きや、変数定義後の使い方など不明点、不備がありますが、これを元にじぶんでも作れるように頑張ります! ありがとございました!

お礼日時:6/24 18:01

その他の回答(1件)

0

説明が確定的ではなくプログラムもおかしいので次のような場合です。 転記元フォルダの全てのExcelファイルが転記対象。 転記元はSheet1のA列からE列までの5列の2行目からA列最終行までを転記。 転記先はVBAがあるBookのSheet1。 転記元シートのA:E列の転記対象を、B:F列(5列)にコピー。 A列は転記元Book名のドットから前の部分。 Book毎に1行開ける。 Sub sample() Dim folder As String Dim file As String Dim wb As Workbook Dim sws As Worksheet '転記元Sheet(SourceWorksheet) Dim dws As Worksheet '転記先Sheet(DestinationWorksheet) Dim r As Long Dim lastRow As Long Dim n As Long Set dws = Sheets("Sheet1") '転記先Sheet dws.Cells.ClearContents '転記先クリア dws.Range("B1:F1").Value = Array("名前", "重さ", "抜け", "結果1", "結果2") r = 2 '転記先行(初期値=2) folder = "C:\sample\" '転記元Bookのあるフォルダ+"\" file = Dir(folder & "*.xls?") 'フォルダ内の最初のExcelファイル名 Do While file <> "" 'ファイル名がある間 Set wb = Workbooks.Open(folder & file) '転記元Bookを開く Set sws = wb.Sheets("Sheet1") '転記元Sheet lastRow = sws.Range("A" & Rows.Count).End(xlUp).Row '転記元シートのA列最終行 n = lastRow - 1 '転記行数(2行目から最終行なので) dws.Cells(r, "A").Resize(n, 1).Value = Split(file, ".")(0) 'A列転記行から下に行数分ファイル名のドットの前までの値を表示 dws.Cells(r, "B").Resize(n, 5).Value = sws.Range("A2:E" & lastRow).Value 'B列転記行から転記元シートのA:E列の2行目からA列最終行までの範囲をコピー r = r + n + 1 '転記行+転記行数+1(次の転記行) wb.Close False '転記元Bookを保存せずに閉じる file = Dir 'フォルダ内の次のExcelファイル名 Loop '繰り返す End Sub ちなみに