VBA to copy rows from closed files to text file

[anuradha.vjc]

Hi

I am new to this forum and require help in excel.

I have a folder "C:\Data" which has 82 excel files. I have to open each of the file and copy entire row from Row 25 to Row 150 of a perticular sheet named "APGEN" to a txt file.

Can a vba - Select the rows 25 to 150 from each of the these files of the sheet named "APGEN" in the folder without opening the xl files and copy them to a single txt file.

Regards
Anuradha

 

[Krishnakumar]

Hi Anuradha,

Try this. Untested

Sub kTest()
    
    Dim kText   As String, k As Range, r   As Long
    Dim fso As Object, wbkOpen  As Workbook
    Dim f, FileName As String, wbkActive As Workbook
    
    Set fso = CreateObject("scripting.filesystemobject")
    
    Const MyFolder  As String = "C:\Data\"
    FileName = Dir(MyFolder & "*.xls*")
    
    With Application
        .ScreenUpdating = 0
        .DisplayAlerts = 0
    End With
    
    Set wbkActive = ThisWorkbook
    
    Do While Len(FileName)
        Set wbkOpen = Workbooks.Open(MyFolder & FileName, 0)
        On Error Resume Next
        With wbkOpen.Worksheets("APGEN")
            .Cells(1) = .Parent.Name
            If Err.Number <> 0 Then
                Err.Clear: On Error GoTo 0: GoTo Nxt
            End If
            Set k = Intersect(.UsedRange, .Rows("25:150"))
            With k
                For r = 1 To .Rows.Count
                    kText = kText & vbNewLine & Join$(Application.Transpose(Application.Transpose(.Rows(r).Value)), vbTab)
                Next
            End With
        End With
Nxt:
        wbkOpen.Close 0
        Set wbkOpen = Nothing
        FileName = Dir()
    Loop
    
    Set f = fso.opentextfile(MyFolder & "test.txt", 8, 1)
    f.write kText
    f.Close
    
    MsgBox "The text file has been saved in " & MyFolder, vbInformation
    
    With Application
        .ScreenUpdating = 1
        .DisplayAlerts = 1
    End With
    
End Sub

HTH