フォルダの中に、あるアンケートに対する回答のエクセルファイルがあり(名前はバラバラ)、別の場所にその回答を一覧に並べるための"集計用ファイル"がります。このアンケートの回答ファイルは日々数が追加されて行くので、毎日"集計用ファイル"に回答を得た分を転記し日付の名前でもつけて保存して行きたいのです。エクセルマクロを使用して、回答ファイルの特定の部分に入力された内容を一人一列となるように"集計用ファイル"へ転記します。こちらで教えて頂いたりネットや本を見て下記までは理解しました。
■質問
各行の先頭に転記元のファイル名も記入するにはどの様な記述が必要かおしえてください。いろいろ試したのですが、力量不足でエラーもしくは全く反映されないものしか出来ませんでした。
よろしくお願い致します。
=============================================
Sub 転記2()
Dim WorkPath As String
Dim Target As String
Dim MaxRow As Long
Application.ScreenUpdating = False
WorkPath = "C:\Documents and Settings\Zawa\デスクトップ\Test"
Target = Dir(WorkPath & "\*.xls", vbNormal)
MaxRow = 1
Do While Target <> ""
Workbooks.Open WorkPath & "\" & Target
Workbooks(Target).Sheets("Sheet1").Rows("1:1").Copy _
ThisWorkbook.Sheets("Sheet1").Cells(MaxRow, 1)
MaxRow = MaxRow + 1
Workbooks(Target).Close SaveChanges:=False
Target = Dir()
Loop
MsgBox "転記が終了しました。"
End Sub
No.2ベストアンサー
- 回答日時:
おはようございます。
merlionXXです。前回の続きのようですね。
Workbooks(Target).Sheets("Sheet1").Rows("1:1").Copyと、1行目全部をコピーしているのはデータの範囲(どの列までなのか)が一定ではないからなのでしょうか?
だったらこうしてみてください。入力のある最右列の列番号を取得しXとします。
Sub 転記2()
Dim WorkPath As String
Dim Target As String
Dim MaxRow As Long, x As Long
Application.ScreenUpdating = False
WorkPath = "C:\Documents and Settings\Zawa\デスクトップ\Test"
Target = Dir(WorkPath & "\*.xls", vbNormal)
MaxRow = 1
Do While Target <> ""
If Target <> ThisWorkbook.Name Then
Workbooks.Open WorkPath & "\" & Target
With Workbooks(Target)
With .Sheets("Sheet1")
x = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 1), .Cells(1, x)).Copy ThisWorkbook.Sheets("Sheet1").Cells(MaxRow, 2)
End With
ThisWorkbook.Sheets("Sheet1").Cells(MaxRow, 1).Value = Target
MaxRow = MaxRow + 1
.Close SaveChanges:=False
End With
End If
Target = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "転記が終了しました。"
End Sub
またまたありがとうございました。
イロイロな書き方がるんですね。
本当に勉強になります。
前回教えて頂いた内容もあわせ、ここ数日でぐっと理解が進みました。ありがとうございました。<(_ _)>
No.3
- 回答日時:
#1です。
回答ではないですが読み込みたいシートと範囲が決まっているのなら、
ブックを開かないで読む
http://officetanaka.net/excel/vba/tips/tips28.htm
も一読されておくと良いかもです。
No.1
- 回答日時:
>Workbooks(Target).Sheets("Sheet1").Rows("1:1").Copy
これが例えばA~F列なら
~.Range("A1:F1").Copy
として
>ThisWorkbook.Sheets("Sheet1").Cells(MaxRow, 1)
ThisWorkbook.Sheets("Sheet1").Cells(MaxRow, 2)
⇒B列に貼付け
ThisWorkbook.Sheets("Sheet1").Cells(MaxRow, 1).Value = Target
を追加すればよいのでは?
無事に名前を取得できました。
ありがとうございます。
よりシンプルな書き方を教えて頂きどんどん理解が進んできました。もう一歩でブレイクスルーしそうな予感です。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・ちょっと先の未来クイズ第4問
- ・【大喜利】【投稿~10/21(月)】買ったばかりの自転車を分解してひと言
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・ハマっている「お菓子」を教えて!
- ・最近、いつ泣きましたか?
- ・夏が終わったと感じる瞬間って、どんな時?
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・都道府県穴埋めゲーム
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【スプレドシート】IMPORTRANGE...
-
エクセルでファイルを開かずに...
-
CPU使用率が100%となっ...
-
Excel 2枚目のブックが開かな...
-
MATLABでcsvファイルを読み込も...
-
ファイル内にある数字の出現回...
-
複数のtxtの特定部分を抽出し、...
-
エクセルマクロ 数式【VLOOKUP...
-
パワーポイントをエクセルファ...
-
エクセルで「500時間」を「何日...
-
EXCELで上書き保存しないと反映...
-
エクセルで複数のブックで「元...
-
エクセル関数の解読サイトなん...
-
メモ帳で開く設定を元に戻したい。
-
メール添付されているファイル...
-
エクセルVBAでアクセスファイル...
-
エクセルでファイルを閉じても...
-
エクセル 列の最大数はIV?
-
エクセルの塗りつぶしの色が勝...
-
エクセルを上書き保存したのに...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【スプレドシート】IMPORTRANGE...
-
エクセルでファイルを開かずに...
-
複数のtxtの特定部分を抽出し、...
-
Excel 2枚目のブックが開かな...
-
CPU使用率が100%となっ...
-
PhotoshopでExcelのファイルが...
-
エクセルで他のファイルのセル...
-
エクセルマクロ 数式【VLOOKUP...
-
VBAで集計元のファイル名を取得...
-
MATLABでcsvファイルを読み込も...
-
複数エクセルファイルのレコー...
-
one drive からExcel onlineを...
-
エクセルマクロ(vba)のFSO.Open...
-
マクロで別ファイルのシートコ...
-
エクセルでハイパーリンクが貼...
-
エクセル保存後に別のブックの...
-
Excel2000のセルの書式設定メニ...
-
マクロでシートのデータをコピ...
-
VBAで.docのみを抽出
-
Excel2000でフォルダを移動する...
おすすめ情報