| |
お世話になっています。
履歴を参考に、複数のエクセルデータの集計用マクロを作成していますが、うまくいきません。どなたか、アドバイス願います。
任意のホルダに、同一形式のエクセルシートを保存しています。
マクロにてホルダ内の任意のエクセルファイルを選択し、集計したいファイルのPathを取得。
ホルダ内のエクセルファイル全ての、"Sheet1"のデータを、1つのシート（マクロ作成してあるエクセルの"Anal"シート）にまとめる。
作成したマクロ
Sub test()
Dim FSO As Object
Dim MyPath As String, folpath As String, folmei As String, fmei As String
Dim fbasename As String, kaku As String, strPath As String
Dim vntFileName As Variant
Dim DataJ As Range
Dim i, j
' Dim 新規Sheet As Object, 既存Sheet As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
vntFileName1 = ThisWorkbook.Name
If GetWriteFile(vntFileName, strPath) Then
MyPath = vntFileName 'ファイルのフルパス
folpath = FSO.getparentfoldername(MyPath) 'フォルダのパス
folmei = FSO.getfolder(folpath).Name 'フォルダ名
fmei = FSO.getfile(MyPath).Name 'ファイル名
fbasename = FSO.getbasename(MyPath) 'ファイル名から拡張子を除いた部分
kaku = FSO.GetExtensionName(MyPath) '拡張子
xlsFile = Dir(folpath & "\*.xls")
Do While xlsFile <> ""
Workbooks.Open folpath & "\" & xlsFile
j = Workbooks(xlsFile).Worksheets("Sheet1").Range("F65536"). _
End(xlUp).Row
Set DataJ = Workbooks(xlsFile).Worksheets("Sheet1"). _
Range("A3:R" & j)
i = Workbooks(vntFileName1).Worksheets("Anal"). _
Range("F65536").End(xlUp).Row
DataJ.Copy Workbooks(vntFileName1). _
Worksheets("Anal").Range("A" & i)
Set DataJ = Nothing
Workbooks(xlsFile).Activate
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
Loop
End If
Set FSO = Nothing
End Sub
Private Function GetWriteFile(vntFileName As Variant, _
Optional strFilePath As String) As Boolean
Dim strFilter As String
Dim strInitialFile As String
strFilter = "Excel Book (*.xls),*.xls"
strInitialFile = vntFileName
If strFilePath <> "" Then
ChDrive Left(strFilePath, 1)
ChDir strFilePath
End If
vntFileName _
= Application.GetSaveAsFilename(vntFileName, strFilter, 1)
If vntFileName = False Then
Exit Function
End If
GetWriteFile = True
End Function
上記マクロでは、フォルダ内の選択したファイルだけで、無限ループに入ってしまいます。修正点を教えていただけないでしょうか？
よろしくお願い致します。
|
|
たかし
- 09/2/3(火) 18:03 -
