VBA 2つの範囲をコピーして結合し、テキストファイルに保存します

Question

2つの別々のワークシートの2つのセル範囲を1つのファイルにコピーし、それらを結合してテキストファイルに保存する必要があります。私はtxtに1つの範囲のセルを保存する方法しか知りません。以下のコードのようなファイルです。

Dim LastRow As Long 
Dim Count As Range 

LastRow = Range("K" & Sheets("Reports").Rows.Count).End(xlUp).Row 

    Dim wbText As Workbook 
    Dim wsReports As Worksheet 

    Set wbText = Workbooks.Add 

    Set wsReports = ThisWorkbook.Worksheets("Reports") 

    With wsReports 
    .Range("Q2" & ":Q" & LastRow).Copy wbText.Sheets(1).Range("A1") 
    End With 

    Application.DisplayAlerts = False 

    With wbText 
    .SaveAs Filename:="P:\Newsletter Email.txt", FileFormat:=xlText 
    .Close False 
    End With 

テキストファイルへのシートのレポートでこのコードをコピー欄Fが、私はまた、テキストファイルにシートReports1から列Lをコピーする必要があります。私は知っている

RangeCombined = Union(Range1, Range2) 

どのようにこの状況にこのコードを統合することができますか？

ありがとうございます。

Answer 1

を試してみてください。これは、出力の列Bに列出力のA、および列Reports1のFにレポートの列Qをコピーします

Dim LastRow As Long 
Dim LastRow1 As Long 
Dim Count As Range 

Dim wbText As Workbook 
Dim wsReports As Worksheet 
Dim wsReports1 As Worksheet 

Set wbText = Workbooks.Add 

Set wsReports = ThisWorkbook.Worksheets("Reports") 
Set wsReports1 = ThisWorkbook.Worksheets("Reports1") 

LastRow = wsReports.Range("K" & wsReports.Rows.Count).End(xlUp).Row 
LastRow1 = wsReports1.Range("K" & wsReports1.Rows.Count).End(xlUp).Row 

wsReports.Range("Q2" & ":Q" & LastRow).Copy wbText.Sheets(1).Range("A1") 
wsReports1.Range("F2" & ":F" & LastRow1).Copy wbText.Sheets(1).Range("B1") 

Application.DisplayAlerts = False 

With wbText 
    .SaveAs Filename:="P:\Newsletter Email.txt", FileFormat:=xlText 
    .Close False 
End With 

を試してみてください。

また、あなたがReports1の列Fがために、レポートの列Qの下に表示されるコピー文を変更する場合：

wsReports.Range("Q2" & ":Q" & LastRow).Copy wbText.Sheets(1).Range("A1") 
wsReports1.Range("F2" & ":F" & LastRow1).Copy wbText.Sheets(1).Range("A" & LastRow) 

（レポートとReports1の両方で同じ数の行がある場合は、

Answer 2

私は最良の方法は、ファイルを印刷中にパスに保存することです。この

Dim FilePath As String 
Dim lCol As String 
Dim fCol As String 
Dim fRange As String 
Dim lRange As String 
Dim wsReports As Worksheet 
Dim wsReports1 As Worksheet 

Set wsReports = ThisWorkbook.Worksheets("Reports") 
Set wsReports1 = ThisWorkbook.Worksheets("Reports1") 

FilePath = "P:\Newsletter Email.txt" 

fRange = "F2:F" & LastRow 
lRange = "L2:L" & LastRow 
'Will create the file if it does not exist 
Open FilePath For Output As #1 
With wsReports 
.Range("Q2" & ":Q" & lastrow).Copy wbText.Sheets(1).Range("A1") 
For i = 0 To lastrow 
fCol = .Cells(i, "F") 

Print #1, fCol 
Next i 

End With 
With wsReports1 
For i = 0 To lastrow 
lCol = .Cells(i, "L") 
Print #1, lCol 
Next i 
End With 
'Make sure to close it or you'll have difficulties opening the file 
Close #1