Question

我需要从一个文件中的两个单独的工作表中复制两个单元格范围，然后将它们组合，然后保存到文本文件中。我只知道如何将一系列单元格保存到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复制到文本文件中，但我还需要将工作表Reports1中的L列复制到文本文件中。我知道

RangeCombined = Union(Range1, Range2)

可以组合两个范围，如何将此代码集成到这种情况中？

提前致谢。

Answer 1

尝试

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出现在Reports的列Q下面，请将Copy语句更改为：

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中的行数相同，则可以稍微简化一下。）

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

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

2 个答案: