VBA复制两个范围并合并它们,然后保存在文本文件中

我需要从一个文件中的两个单独的工作表中复制两个单元格区域,然后将它们合并,然后保存到文本文件中。 我只知道如何将一个范围的单元格保存到txt中。 像下面的代码文件。

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 

此代码将工作表Reports中的列F复制到文本文件中,但我也需要将工作表L中的列L复制到文本文件中。 我知道

 RangeCombined = Union(Range1, Range2) 

可以结合两个范围,我怎么能将这个代码整合到这种情况?

提前致谢。

尝试

 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 

这会将Reports的列Q复制到输出的列A中,并将Reports1的列F复制到输出的B列中。

或者,如果您希望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) 

(如果Reports和Reports1中的行数相同,则可以简化一下。)

我认为最好的办法是将文件保存到一个path,而打印到它。 尝试这个

 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