| |
>bookが２０個ほど
これ(処理対象のブック)のみを、一つの専用フォルダーに保存して下さい。
そのフォルダーのパスを、仮に
C:\Documents and Settings\User\My Documents\ExcelFiles
とします。次に新規ブックを作成し、その先頭(左端)シートのA1:M1に
"店名","1月","2月"・・・と入力しておきます。
VBEを開いてメニューの「挿入」「標準モジュール」を選択し、挿入された
モジュールに以下のマクロを入れて下さい。
Sub MyShop_SaleData()
Dim MyF As String
Dim CkC As Variant
Dim WS As Worksheet
Dim xR As Long
Dim C As Range
Const Ph As String = _
"C:\Documents and Settings\User\My Documents\ExcelFiles\"
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Worksheets(1)
MyF = Dir(Ph & "*.xls")
Do Until MyF = ""
xR = WS.Cells(65536, 1).End(xlUp).Row + 1
WS.Cells(xR, 1).Value = Left$(MyF, Len(MyF) - 4)
Workbooks.Open Ph & MyF
With ActiveWorkbook
For Each C In .Worksheets(1).Rows(1).SpecialCells(2)
CkC = Application.Match(C.Value, WS.Range("A1:M1"), 0)
If Not IsError(CkC) Then
WS.Cells(xR, CkC).Value = C.Offset(1).Value
End If
Next
.Close False
End With
MyF = Dir()
Loop
Application.ScreenUpdating = True: Set WS = Nothing
MsgBox "データの転記を完了しました", 64
End Sub
定数 Ph を正確なパス(末尾は必ず"\"にする)に修正し、実行してみて下さい。
なお各店ブックのデータは、そのブックの先頭シートにあるものとしています。
もしそうなっていなければ、先頭へ移動して上書き保存しておいて下さい。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
