|
▼VBA初心者 さん:
>1行目と2行目を見出しとしてコピーして、1行目と2行目は固定
>してExcel表に出力したいです。
>
>'◆見出し行をCopyしてのところを[A1:A2]にしたり、Tbl.Rows(2).Copy
>にしたりしても2行目だけ出力されたりしてしまいます。
>Sub Lesson_Print()
> Dim Tbl As Range
> Dim v, i As Long, n As Long, n1 As Long
> Dim myPath As String
> Dim nSheet As Long
> Dim newBook As Workbook
> Dim Bookname As String
>
> With Application
> nSheet = .SheetsInNewWorkbook
> .SheetsInNewWorkbook = 1
> .DisplayAlerts = False
> End With
>
> myPath = ActiveWorkbook.Path & "\"
> Set Tbl = ActiveSheet.[A1].CurrentRegion '◆ A列で Sort済み
> n = Tbl.Rows.Count
> v = Tbl.Resize(Tbl.Rows.Count + 1, 1).Value
> n1 = 2
> For i = 2 To n
> If v(i, 1) <> v(i + 1, 1) Then '下と違えば
> With Workbooks.Add
> Tbl.Rows(1).Copy .Sheets(1).[A1] '◆見出し行をCopy
> Tbl.Rows(n1 & ":" & i).Copy .Sheets(1).[A2]
>
> .Sheets(1).UsedRange.EntireColumn.AutoFit '◆挿入
>
> (中 略)
>
> Application.SheetsInNewWorkbook = nSheet
>
> MsgBox "出力しました"
>
>End Sub
この部分、こんな感じにしてみたらどうですか?
Sub Lesson_Print2() 'タイトル2行
Dim Tbl As Range
Dim v, i As Long, n As Long, n1 As Long
Dim myPath As String
Dim newBook As Workbook
Dim Bookname As String
Application.DisplayAlerts = False
myPath = ActiveWorkbook.Path & "\"
Set Tbl = ActiveSheet.[A1].CurrentRegion '◆ A列で Sort済み
n = Tbl.Rows.Count
v = Tbl.Resize(n + 1, 1).Value
n1 = 3 '◆変更
For i = 3 To n '◆変更
If v(i, 1) <> v(i + 1, 1) Then '下と違えば
With Workbooks.Add(xlWBATWorksheet) '◆変更 シート1枚のBook
Tbl.Rows("1:2").Copy .Sheets(1).[A1] '◆見出し行2行をCopy
Tbl.Rows(n1 & ":" & i).Copy .Sheets(1).[A3] '3行目へ
.Sheets(1).UsedRange.EntireColumn.AutoFit '◆挿入
> (中 略)
>
'Application.SheetsInNewWorkbook = nSheet
>
> MsgBox "出力しました"
>
>End Sub
|
|