Something like this should work:

Sub test()

Dim LR As Long

Dim oSheet As Worksheet

Dim hFile As Long

Dim strFile As String

Dim bOpenFile As Boolean

Dim arr

strFile = "C:\test.csv"

bOpenFile = True

For Each oSheet In ActiveWorkbook.Sheets

With oSheet

LR = .Cells(65536, 1).End(xlUp).Row

If Not IsEmpty(Cells(LR, 1)) Then

arr = Range(Cells(1), Cells(LR, 2))

SaveArrayToTextAppend strFile, arr, hFile, bOpenFile, False

bOpenFile = False

End If

End With

Next oSheet

Close #hFile

End Sub

Sub SaveArrayToTextAppend(strFile As String, _

arr As Variant, _

hFile As Long, _

Optional bOpenFile As Boolean = True, _

Optional bCloseFile As Boolean = True, _

Optional ByVal LBRow As Long = -1, _

Optional ByVal UBRow As Long = -1, _

Optional ByVal LBCol As Long = -1, _

Optional ByVal UBCol As Long = -1)

Dim r As Long

Dim c As Long

If LBRow = -1 Then

LBRow = LBound(arr, 1)

End If

If UBRow = -1 Then

UBRow = UBound(arr, 1)

End If

If LBCol = -1 Then

LBCol = LBound(arr, 2)

End If

If UBCol = -1 Then

UBCol = UBound(arr, 2)

End If

If bOpenFile Then

hFile = FreeFile

Open strFile For Append As #hFile

End If

For r = LBRow To UBRow

For c = LBCol To UBCol

If c = UBCol Then

Write #hFile, arr(r, c)

Else

Write #hFile, arr(r, c);

End If

Next c

Next r

If bCloseFile Then

Close #hFile

End If

End Sub

RBS