여러 범위를 txt 파일로 내보내기

Question

여러 워크 시트의 여러 범위를 단일 텍스트 파일로 내 보내야 셀 범위가 하나씩 추가되기를 원합니다. 현재 하나의 범위 워크 시트에 대해 완벽하게 작동하는이 코드를 사용하고 있는데 더 많은 범위에서 작동하도록이 코드를 수정해야합니까?

예 내가이 텍스트 파일로 그 범위를 내보낼 수있는 가장 빠른 방법입니다 위의 코멘트에서 언급 한 것처럼

Sheet1 A2:E50 
Sheet2 A2:F60 
Sheet4 A2:C45 

현재 코드를

Sub Export() 
Dim r As Range, c As Range 
Dim sTemp As String 

Open Workbooks("Test.xlsm").Path & "\Test.SQL" For Output As #1 
For Each r In Worksheets("SQL1").Range("A1:D50").Rows 
    sTemp = "" 
    For Each c In r.Cells 
     sTemp = sTemp & c.Text & Chr(9) 
    Next c 

    'Get rid of trailing tabs 
    While Right(sTemp, 1) = Chr(9) 
     sTemp = Left(sTemp, Len(sTemp) - 1) 
    Wend 
    Print #1, sTemp 
Next r 
Close #1 
End Sub 

Answer 1

을 추가하고 싶습니다 범위. 의견

싯다 르트 나라 얀에서

Dim Thiswb As Workbook, thatWb As Workbook 

Sub Sample() 
    Set Thiswb = ThisWorkbook 
    Set thatWb = Workbooks.Add 

    CopyRange Thiswb.Sheets("Sheet1"), Thiswb.Sheets("Sheet1").Range("A1:E10000") 
    CopyRange Thiswb.Sheets("Sheet2"), Thiswb.Sheets("Sheet2").Range("A1:F10000") 
    CopyRange Thiswb.Sheets("Sheet3"), Thiswb.Sheets("Sheet3").Range("A1:C10000") 

    Application.DisplayAlerts = False 
    thatWb.SaveAs "C:\Temp.csv", xlCSV 
    Application.DisplayAlerts = True 
End Sub 

Sub CopyRange(ws As Worksheet, rng As Range) 
    Dim lRow As Long 

    lRow = thatWb.Sheets(1).Range("A" & thatWb.Sheets(1).Rows.Count).End(xlUp).Row + 1 

    rng.Copy thatWb.Sheets(1).Range("A" & lRow) 
End Sub 

후속 프로세스 내 위의 코드는 SQL 및 JAVA에 플러그로이 나를 위해 usful하지만 늘 작품이다

안된 필요하지 루핑 없습니다 ... VBA에서별로 좋지 않은 메트로 전화였습니다. (풍차 5 분 전

이게 너가하려는거야? 여기에 (안된)

Sub Sample() 
    Dim Thiswb As Workbook 
    Set Thiswb = ThisWorkbook 

    Export Thiswb.Sheets("Sheet1").Range("A2:E50") 
    Export Thiswb.Sheets("Sheet2").Range("A2:F60") 
    Export Thiswb.Sheets("Sheet4").Range("A2:C45") 
End Sub 

Sub Export(rng As Range) 
    Dim r As Range, c As Range 
    Dim sTemp As String 

    '~~> Use Append instead of Output 
    Open Workbooks("Test.xlsm").Path & "\Test.SQL" For Append As #1 

    For Each r In rng.Rows 
     sTemp = "" 
     For Each c In r.Cells 
      sTemp = sTemp & c.Text & Chr(9) 
     Next c 

     'Get rid of trailing tabs 
     While Right(sTemp, 1) = Chr(9) 
      sTemp = Left(sTemp, Len(sTemp) - 1) 
     Wend 
     Print #1, sTemp 
    Next r 
    Close #1 
End Sub