|
>▼マリモ さん:
> '------ 抽出データをコピー
> r.Columns("D:F").Copy
> copyBook.Worksheets(1).Range("H1").PasteSpecial Transpose:=True
> copyBook.Save
> copyBook.Close False
>
> r.AutoFilter
のところは 2つ目以降の表のとき、[H1]へ上書きコピーしてしまうので
都合が悪いです。
その部分、たとえば以下のように修正してください。
'------ 抽出データをコピー
Dim CopyTo As Range
r.Columns("D:F").Copy
Set CopyTo = copyBook.Worksheets(1).Cells(Rows.Count, "H").End(xlUp)
If CopyTo.Row > 1 Then Set CopyTo = CopyTo.Offset(1)
CopyTo.PasteSpecial Transpose:=True
copyBook.Save
copyBook.Close False
r.AutoFilter
|
|