VBA 두 범위를 복사하여 결합한 다음 텍스트 파일에 저장하십시오.

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 

텍스트 파일의 시트 보고서에서이 코드를 복사 열 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 

이 출력 탑 A에보고 칼럼 Q 복사 할 시도하려고 출력 칼럼 B로 Reports1 열에 F.

다른 방법으로, 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