| |
VBA初心者で知識が乏しく、色々なコードを参考に作っているですが
行き詰ってしまいました。
お力をお貸しいただけたら、大変ありがたいです。
フォルダー(DATA)の中に入っている、
ファイル名「時間外」で始まるすべてのファイルに処理をします。
ファイルの中身はシートで分かれていて、すべて同じフォーマットの表
が入っています。
ファイルごとに入っている表のデータを別ファイル「表題.xls」に
貼り付け、1つの表のデータにしたいと思っています。
（下にどんどん貼り付けていく）
その際、シート名「サンプル」とA5にデータのないシートに関しては
シートを削除しています。
Sub MyWorkbooks()
Dim sFolderName As String
Dim sFileName As String
'対象フォルダの設定
sFolderName = ThisWorkbook.Path & "\DATA\"
'"時間外"で始まるファイル名を取得
sFileName = Dir$(sFolderName & "時間外*.xls")
'ファイル名の列挙が終わるまで実行します
Do Until sFileName = ""
'ブックを開きます
Workbooks.Open sFolderName & sFileName
'ブックに対する処理
Proc
'次のファイル名を取得
sFileName = Dir$()
Loop
End Sub
'ブックに対する処理
Sub Proc()
Dim intLoop As Integer
Dim LastRow As Integer
Dim myfile As String
Dim HLastRow As Integer
myfile = ActiveWorkbook.Name
For intLoop = 1 To Worksheets.Count
If Worksheets(intLoop).Range("A5").Value = "" _
Or Worksheets(intLoop).Name = "サンプル" Then
If Worksheets.Count > 1 Then Worksheets(intLoop).Delete
Else
Range("A65536").End(xlUp).Select
LastRow = ActiveCell.Row
Range("A5:T" & LastRow).Copy
Windows("表題.xls").Activate
Cells(65536, 1).End(xlUp).Offset(1).Select
HLastRow = ActiveCell.Row
Range("A" & HLastRow).Select
ActiveSheet.Paste
Workbooks("myfile.xls").Activate
End If
Next intLoop
End Sub
「表題.xls」に貼り付けるまでは、なんとか動いたのですが
「表題.xls」からコピー元のファイルに戻って、
次のシートも同じ処理をさせるところが、分かりません。
どうか、ご指導お願い致します。
|
|
ゆき太
- 06/7/27(木) 14:38 -
