[[20160819111349]] 『まとめるマクロが実行できません』(初心者ママ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『まとめるマクロが実行できません』(初心者ママ)

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 >


理想的なコーディングではありませんが、それでも動きそうに見えますね。
まずは、このマクロをF8キーでステップ実行してみてください。Do Whileループの内側の処理は実行されているでしょうか?
(つまり、目的のブックはOpenできているでしょうか)

気になった点は、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


試してみたところ、"\*.xls" でも良いみたいですね。ちゃんと動いたので、A1セルの打ち間違いが無いか、確認してみてください。

おまけで、私も整形例なぞ。

 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

F8で試したところ動きました。ありがとうございました。

もう一ついいでしょうか。
各ファイルの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


Sheets("Sheets(1)").Range("A5:J1000").Copyでよろしいのでしょうか?
よろしくお願い致します
(初心者ママ) 2016/08/19(金) 13:29

いや、Sheets(1).Range("A5:J1000").Copy ということです。
名前の代わりに、1番目、という指定です。
(???) 2016/08/19(金) 13:45

失礼しました。できました!
感激です。すごく助かりました。
どんどん出来ると欲がでてきてしまいます。

次回までに、まとめる前に項目以外のデータを消すというマクロにチャレンジしたいです。
本当にありがとうございました。
(初心者ママ) 2016/08/19(金) 14:19


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.