今週のキャリッジさん

とある銀座の零細システム会社の社員ブログ

会社設立の決意 昔のお客さんとExcel

2月 9th, 2010

ちわっ。キャリッジさんです。

とあるお客さんからこんなメールが、、、

数百ファイルあるエクセルブックの1シート目だけを1ブックにまとめたいなぁ、、、

中々、控えめながら挑戦的なメール。

30分以内に回答します。と返信。

どうやら新しい案件に入って、情報を整理しているらしい。個人的なお願いごとのようなので個人的に対応。う~む、VBAなんて数年ぶりだぞ、いけるか??

というわけでこちらがその結果。小一時間かかってしまったけれども、ありがとうのメールを頂いたところから要件どおりに動いているみたい。


Sub maji_merge()
    Dim rngDest As Range
    Dim myPath As String
    Dim myBookName As String
    Dim mySheet As Worksheet

    myPath = ThisWorkbook.Path & "\"
    myBookName = Dir(myPath & "*.xls")
    If myBookName = "" Then Exit Sub

    Set rngDest = Workbooks.Add.Worksheets(1).Range("A1")

    Do Until myBookName = ""
        If myBookName = ThisWorkbook.Name Then
        Else
            With Workbooks.Open(myPath & myBookName)

                Set mySheet = .Worksheets(1)
                If mySheet.FilterMode = True Then
                    mySheet.ShowAllData
                End If
                    With mySheet.Range(mySheet.Cells(6, 1), _
                    mySheet.Cells(mySheet.Range("A6").End(xlDown).Row, 255))
                    .Copy rngDest
                        Set rngDest = rngDest.Offset(.Rows.Count)
                    End With

                .Close False
            End With
        End If
        myBookName = Dir()
    Loop
    MsgBox "完了!"
End Sub

システム屋の営業ツールはプログラム。数行のコードで喜んでもらえるし、やっぱこうあるべきだと思う今日この頃。

Leave a Reply