VBAでの訂正のアドバイスをお願いします。

質問

下記のコードはテキストファイルを複数選んでＡ列の最終行に出力するためのものなのですが
今の状態だと出力したデータの空白行が消えてしまっていて次の段階に進めません。
このコードを使う前、テキストファイルを一枚一枚コピー＆貼り付けして作業していました。
その場合は空白行もそのままの状態でした。

空白行もそのまま出力するにはどこを変更すればいいのかアドバイスお願いします。
よろしくお願いします。

Sub 連続出力()
Dim xFile As Variant, i As Long, sh As Worksheet, bk1 As Workbook
xFile = Application.GetOpenFilename(FileFilter:="テキスト ファイル (*.txt), *.txt", MultiSelect:=True)
If IsArray(xFile) Then
Set sh = ActiveSheet
Application.ScreenUpdating = False
For i = LBound(xFile) To UBound(xFile)
With Workbooks.Open(xFile(i))
.Worksheets(1).Columns(1).SpecialCells(xlCellTypeConstants).Copy
If sh.Cells(1).Value = "" Then
sh.Cells(1).PasteSpecial xlValues
Else
sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues
End If
Application.CutCopyMode = False
.Close SaveChanges:=False
End With
Next i
Application.ScreenUpdating = False
End If
End Sub

回答No.2

kybo

空白行もそのまま出力するには、
SpecialCells(xlCellTypeConstants).はデータのあるセルだけをコピーするという意味なので、

.Worksheets(1).Columns(1).SpecialCells(xlCellTypeConstants).Copy

を

.Worksheets(1).Columns(1).Copy

とします。

お礼

回答ありがとうございました。
一度試してみますね。

回答No.1

kybo

sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues

の行を↓の様にshを付けて、「sh.Rows.Count」としてみて下さい。

sh.Cells(sh.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues

お礼

そのように変えるだけでできるんですね。
ありがとうございました。