[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『まとめるマクロが実行できません』(初心者ママ)
Sub Sample1()
Dim buf As String, i As Long Dim j buf = Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls") Do While buf <> "" Workbooks.Open Worksheets("Sheet1").Range("A1").Value & "\" & buf Sheets("Sheet1").Range("A1:J1000").Copy ThisWorkbook.Activate Range("A65536").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste Workbooks(buf).Activate Application.CutCopyMode = False Workbooks(buf).Close SaveChanges:=False buf = Dir() Loop End Sub を標準モジュールへ挿入し、このファイルのSheet1のA1セルにC:\Users\yamada\Desktop\dateと入力しました。 Sheet1以外のシートを選択して 上記マクロを実行しましたが何もおこりません。 修正点を初心者ですので、わかりやすく教えていただけますでしょうか?
< 使用 Excel:Excel2007、使用 OS:Windows7 >
気になった点は、Excel2007なのに、検索しているファイルが旧形式のxlsな点。"\*.xls*" としておけば、新旧両方共該当するようになります。
(???) 2016/08/19(金) 11:27
どのブックのどのシートのどのセルが対象なのかはっきりさせる事です。
問題は
>Sheet1以外のシートを選択して 上記マクロを実行しました
かと思います。
Sub Sample1()
Dim buf As String Dim w As Workbook Dim a As Worksheet Dim s As Worksheet Dim t As String t = Sheets("Sheet1").Range("A1").Value Set a = ActiveSheet buf = Dir(t & "\*.xls") On Error Resume Next Do While buf <> "" Set w = Workbooks.Open(t & "\" & buf) Set s = w.Sheets("Sheet1") If Err.Number = 0 Then s.Range("A1:J1000").Copy _ a.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) Else MsgBox buf & ":" & Err.Description End If w.Close SaveChanges:=False buf = Dir() Loop On Error GoTo 0 End Sub
(ウッシ) 2016/08/19(金) 11:31
Dim buf As String Dim "集計シート".xlsx As Workbook Dim "Sheet1" As Worksheet Dim s As Worksheet
すみません。本当にわかりません。
このように指定するのでしょうか?
(初心者ママ) 2016/08/19(金) 11:38
提示したコードでは動かなかったですか?
とすると、(???)さんのご指摘の通り、C:\Users\yamada\Desktop\date内にxlsファイルが
無かったという事では?
指定の仕方は、
Dim w As Workbook Dim a As Worksheet Dim s As Worksheet
のように、変数を用意して、
Set w = Workbooks.Open(t & "\" & buf) Set s = w.Sheets("Sheet1")
のように、ブック、シートをオブジェクト変数にセットして、
s.Range("A1:J1000").Copy
のように、どのシートのセルなのか明示して処理するようにした方が良いという事です。
(ウッシ) 2016/08/19(金) 11:52
おまけで、私も整形例なぞ。
Sub Test() Dim wk1 As Worksheet Dim wk2 As Worksheet Dim buf As String
Set wk1 = ActiveWorkbook.Sheets("Sheet1") Set wk2 = ActiveSheet
buf = Dir(wk1.Range("A1").Value & "\*.xls*")
Do While buf <> "" With Workbooks.Open(wk1.Range("A1").Value & "\" & buf, False, True) .Sheets("Sheet1").Range("A1:J1000").Copy wk2.Cells(wk2.Rows.Count, "A").End(xlUp).Offset(1, 0) .Close SaveChanges:=False End With buf = Dir() Loop Application.CutCopyMode = False End Sub (???) 2016/08/19(金) 11:57
もう一ついいでしょうか。
各ファイルのSheet1ではなく、名前の付いたシート名を指定してしかも、5行目からまとめたい場合はどのようにしたらいいでしょうか。
よろしくお願い致します。
(初心者ママ) 2016/08/19(金) 13:14
.Sheets("Sheet1").Range("A1:J1000").Copy ↓ .Sheets("名前").Range("A5:J1000").Copy
しかし、シート名はすべて同じでしょうか? 名前の代わりに、.Sheets(1) とすることもできます。この場合、必ず先頭のシートが目的のものである必要がありますが。
コピー元は1行目のままで良くて、出力を5行目からにしたい場合は、転記先シートのA4セルに何か文字を入力しておいてはいかがでしょうか。
(???) 2016/08/19(金) 13:24
次回までに、まとめる前に項目以外のデータを消すというマクロにチャレンジしたいです。
本当にありがとうございました。
(初心者ママ) 2016/08/19(金) 14:19
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.