Copy Values From column “S” From Many Excel Files in a Folder and paste into Special File vb.net

Question

I want to browse a folder and read the first Excel file and copy data in column S and Paste it to another workbook then read the second file and Paste values after the last row of Previous Paste and So on

My Code is

    '''
    Public MyFolder As String
    Public MyFile As String
    Public eRow As Long
    Dim xl As New Excel.Application
    With 
 xl.FileDialog(Microsoft.Office.Core.MsoFileDialogType.msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show()
        MyFolder = .SelectedItems(1) & "\"
        Err.Clear()
    End With
    MyFile = Dir(MyFolder & "\*.xls*", FileAttribute.ReadOnly)
    Dim BBSVal As String
    Dim Lastrow As Long
    BBSVal = cboBBS.Text
    Do While Len(MyFile) > 0
        xl.Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False)
        Lastrow = xl.ActiveSheet.UsedRange.Rows.Count
        xl.ActiveSheet.Range("S1", "S" & Lastrow).Copy()
        xl.ActiveWorkbook.Close(SaveChanges:=vbTrue)
        eRow = xl.Worksheets("BBSName").Cells(xl.Rows.Count, 1).End(Excel.XlDirection.xlUp).Offset(1, 0).Row
        xl.Worksheets("BBSName").Range("A" & eRow.ToString).PasteSpecial()
    Loop
    MyFile = Dir(MyFolder)
'''

The Code Runs Without Error But The Paste is not Done in the Specified File??? Your Help is Highly Appreciated

Thanks, Regards Moheb Labib

Answer 1

     Sub CopyData(ToFile As String, ToSheet As String, ToCol As String, FromFolder As String, FromSheet As String, FromCol As String)
        Dim Xl As New Microsoft.Office.Interop.Excel.Application
        Dim dWorkBook As Workbook
        Try
            Xl.Workbooks.Open(ToFile)
            dWorkBook = Xl.Workbooks(FileIO.FileSystem.GetName(ToFile))
        Catch ex As Exception
            MessageBox.Show(ex.Message & vbCrLf & "file not found or bad format or access error")
            Xl.Application.Quit()
            Xl.Quit()
            Exit Sub
        End Try
        Dim dSheet As Worksheet
        Try
            dSheet = dWorkBook.Sheets(ToSheet)
        Catch ex As Exception
            MessageBox.Show(ex.Message & vbCrLf & "sheet not found or bad name 'ToSheet'")
            Xl.Application.Quit()
            Xl.Quit()
            Exit Sub
        End Try
        If IO.Directory.Exists(FromFolder) = False Then
            MessageBox.Show("Bad path 'FromFolder'" & vbCrLf & FromFolder)
            Xl.Application.Quit()
            Xl.Quit()
            Exit Sub
        End If
        Dim sfiles As String() = IO.Directory.GetFiles(FromFolder, "*.xlsx", SearchOption.TopDirectoryOnly)
        If sfiles.Count = 0 Then
            MessageBox.Show("no excel files '*.xlsx' in directory 'FromFolder'" & vbCrLf & FromFolder)
            Xl.Quit()
            Exit Sub
        End If

        Dim ErrMsg As String = "Error list" & vbCrLf
        Dim faild As Integer = 0
        For Each X As String In sfiles
            Dim tmpWorkBook As _Workbook
            Try
                Xl.Workbooks.Open(X)
                tmpWorkBook = Xl.Workbooks(FileIO.FileSystem.GetName(X))
            Catch ex As Exception
                ErrMsg &= "bad format or access error " & X & vbCrLf
                faild += 1
                GoTo 1
            End Try
            Dim tmpSheet As _Worksheet
            Try
                tmpSheet = tmpWorkBook.Sheets(FromSheet)
            Catch ex As Exception
                ErrMsg &= "sheet not found or bad name  File: " & X & vbCrLf
                faild += 1
                tmpWorkBook.Close()
                GoTo 1
            End Try

            Dim ToRange As Range = dSheet.Range(ToCol & dSheet.Rows.Count).End(XlDirection.xlUp).Offset(1, 0)

            Dim FromRange As Range = tmpSheet.Range(FromCol & "1").End(XlDirection.xlDown)
            Dim tmpAddress As String = FromRange.Address
            FromRange = FromRange.End(XlDirection.xlDown)
            tmpAddress &= ":" & FromRange.Address
            If tmpAddress.EndsWith("1048576") Then
                ErrMsg &= "Column is empty :[ " & FromCol & " ]    File: " & X & vbCrLf
                tmpWorkBook.Close()
                faild += 1
                GoTo 1
            End If
            FromRange = tmpSheet.Range(tmpAddress)
            FromRange.Copy(ToRange)

            tmpWorkBook.Close()

1:
        Next


        dWorkBook.Close(True)
        Xl.Application.Quit()
        Xl.Quit()
        If ErrMsg.Length < 13 Then ErrMsg &= "No Errors" & vbCrLf
        ErrMsg = "Success :" & sfiles.Count - faild & vbCrLf & "Failed :" & faild & vbCrLf & vbCrLf & ErrMsg
        MessageBox.Show(ErrMsg)
    End Sub

Usage

This will copy data from sourceSheet column A to Sheet1 column S

CopyData("c:\test.xlsx", "Sheet1", "S", "D:\folder", "sourceSheet", "A")