画像をアップしたので、こちらを見ていただくと分かりやすいと思いますが、同一フォルダの中に、あるアンケートに対する回答のエクセルファイル(全く同じ形式でだが、ブックの名前に規則性はない)があり、別の場所にその回答を一覧に並べるための"集計用ファイル"がります。このアンケートの回答ファイルは日々数が追加されて行くので、毎日"集計用ファイル"に回答を得た分を転記し日付の名前でもつけて保存して行きたいのです。エクセルマクロを使用して、この"Book1"~"BookXXX"の特定の部分に入力された内容を一人一列となるように"集計用ファイル"のB列から右へ右へと転記したいと考えています。
下記、内容を簡単にしたサンプルを作り、VBAを書いてはみたものの、やはり動きませんでした。(セルは例として3つのみ転記しようとしています)
関連する質問もこちらにさせて頂いたのですが、まだ独力で解決できず再度投稿させて頂きました。よろしくお願いいたします。
Sub 転記()
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("Sum").Select
Range("C7").Select
Selection.Copy
ThisWorkbook.Sheets("Sheet1").Select
Range("B3").Select
ActiveSheet.Paste
Workbooks(Target).Sheets("Sum").Select
Range("C10").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Sheets("Sheet1").Select
Range("B4").Select
ActiveSheet.Paste
Workbooks(Target).Sheets("Sum").Select
Range("D10").Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Sheets("Sheet1").Select
Range("B5").Select
ActiveSheet.Paste
Workbooks(Target).Close SaveChanges:=False
Target = Dir()
Loop
MsgBox "転記が終了しました。"
End Sub
No.1ベストアンサー
- 回答日時:
集計用BOOKが同じフォルダーにおいてもいいように書いてみました。
Dim WorkPath As String
Dim Target As String
Dim i As Long
Application.ScreenUpdating = False
WorkPath = "C:\Documents and Settings\Zawa\デスクトップ\Test"
Target = Dir(WorkPath & "\*.xls", vbNormal)
i = 1
Do While Target <> ""
If Target <> ThisWorkbook.Name Then
Workbooks.Open WorkPath & "\" & Target
i = i + 1 '列番号右にを増やす
With Workbooks(Target)
.Sheets("Sum").Range("C7").Copy ThisWorkbook.Sheets("Sheet1").Cells(3, i)
.Sheets("Sum").Range("C10").Copy ThisWorkbook.Sheets("Sheet1").Cells(4, i)
.Sheets("Sum").Range("D10").Copy ThisWorkbook.Sheets("Sheet1").Cells(5, i)
.Close SaveChanges:=False
End With
End If
Target = Dir()
Loop
MsgBox i - 1 & "件のBOOKの転記が終了しました。"
End Sub
ありがとうございます!
特に
With Workbooks(Target)
.Sheets
.Sheets
.Sheets
と書ける事は始めて知りました。
非常に勉強になりました。
No.2
- 回答日時:
No1 merlionXXです。
Application.ScreenUpdating = True を
MsgBox i - 1 & "件のBOOKの転記が終了しました。" の前に一行入れてください。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) vbaのエラー対応(実行時エラー7:メモリが不足しています) 4 2023/04/24 00:20
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Visual Basic(VBA) 【変更】ファイルを閉じてダイアログで保存した時、更新したシートだけの処理の実行をする 5 2022/03/26 18:31
- Excel(エクセル) エクセル VBAでシートのコピーを作りたい 1 2023/05/18 07:42
- Visual Basic(VBA) エクセルのVBAでダブルクリックでチェックを入れたあと 1 2022/10/26 20:30
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Excel(エクセル) ②Excel 簡単にシートコピーしたら前日の残高と日付を変更させたい→マクロの記録でエラーが出ます 8 2022/07/16 20:40
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel に貼り付けた図形が、保...
-
エクセルが勝手に開く
-
アクセスVBAで既に開いているエ...
-
Excel複数ファイルを1つにまと...
-
ロータス1-2-3のファイルをエ...
-
[大至急!]ExcelSheetFreeの使...
-
ファイル名の末尾に文字を追加...
-
エクセルはシートに関数が入る...
-
エクセルの表示サイズ変更(画...
-
エクセルのファイルの履歴について
-
Microsoft excelが見つからない
-
VBA 新規ファイルを元ファイル...
-
ノーツでボタン
-
Excelファイルをコピー不可にす...
-
エクセルを開くたびにアドイン...
-
エクセルでメールの添付ファイ...
-
メールでCADデータが送られまし...
-
Macで作成したファイル(Word)を...
-
Wordで作成したものをUSBに保存...
-
至急!教えてください!!「Mic...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel に貼り付けた図形が、保...
-
エクセルが勝手に開く
-
アクセスVBAで既に開いているエ...
-
ロータス1-2-3のファイルをエ...
-
Excel複数ファイルを1つにまと...
-
無料エクセル→PC版エクセル
-
Excelファイルをコピー不可にす...
-
エクセルの表示サイズ変更(画...
-
VBA 新規ファイルを元ファイル...
-
ファイル名の末尾に文字を追加...
-
お世話になっています. x軸は時...
-
[大至急!]ExcelSheetFreeの使...
-
EMBEDについて
-
エクセル関数のHyperLinkでの警告
-
エクセルVBAでCSVを読み込んで...
-
エクセルはシートに関数が入る...
-
ワードに貼られたエクセルのリ...
-
xlsファイルの開き方(excel無...
-
エクセル内の1ファイル内のデ...
-
EXCELので作成した表をビルダー...
おすすめ情報