|
こんにちは
こんな感じでしょうか?
Sub test()
Dim f As Variant
Dim b As Workbook
Dim t As Workbook
Dim i As Long
Dim j As Long
Dim a As Areas
f = Application.GetOpenFilename("読み込みファイル (*.*), *.*", , , , False)
If f = False Then Exit Sub
Workbooks.OpenText Filename:= _
f, Origin:=932, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
3, 1)), TrailingMinusNumbers:=True
Set b = ActiveWorkbook
Set t = ThisWorkbook
Set a = b.Worksheets(1).UsedRange.SpecialCells(xlCellTypeConstants).Areas
j = 1
For i = 1 To a.Count
If a(i).Cells(1, 1) Like "No*" Then
If j < 7 Then
t.Worksheets("Sheet" & j).Range("A5").EntireRow.Resize(Rows.Count - 5).ClearContents
a(i).Offset(1).Copy t.Worksheets("Sheet" & j).Range("A5")
j = j + 1
ElseIf j = 7 Then
a(i).Offset(1).Copy t.Worksheets("Sheet" & j).Range("A" & Rows.Count).End(xlUp).Offset(1)
j = j + 1
Else
Exit For
End If
End If
Next
b.Close False
End Sub
|
|