want to append all data of different excels of a folder into one excel sheet

Option 1: Upgrade your Office from 2007 to any latest version to use Power Query to append data from multiple workbooks.

Option 2: Attach a sample of your Main book and 1 sample of your books you want to get data from.

sir

i cant upgrade that is why i wanted to do it through VBA/code

attaching samples

these are just samples ,

number f rows and columns are more in actual files

Kindly append only those rows where column c is not blank

in actual file i want where column I not blank ,that i will replace

Option 2: Attach a sample of your Main book and 1 sample of your books you want to get data from.

main book should include desired results extracted from other book.

HTML Code: 

this code appends the data but in my every excel file first row is a header and in every workbook its same.
and i want to copy those rows only where column I is not blank.

Try this

PHP Code: 

Sub AppendFiles()
Application.ScreenUpdating = False 'Stop screen flickering
Static LoopEnd As Long 'Last row of data in source file
Dim j As Long, k As Long
Dim strPath As String    'Path to source file

strPath = ThisWorkbook.Path 'Get path to source file
Set ObjShell = CreateObject("Shell.Application")
Set objfolder = ObjShell.Namespace(CStr(strPath))

For Each strfilename In objfolder.Items 'Loop through source files
    If Not strfilename = ThisWorkbook.Name Then
        With Sheet1
            .Range("Z1").Formula = "=CountA('" & ThisWorkbook.Path & "\[" & strfilename & "]Sheet1'!A:A" & ")"
            LoopEnd = .Range("Z1").Value - 1
            Destrow = .Range("A" & Rows.Count).End(xlUp).Row
            k = 2
            For j = Destrow To Destrow + LoopEnd
                j = .Range("A" & Rows.Count).End(xlUp).Row + 1
                'Fetch data from source file
                .Range("A" & j).Formula = "='" & ThisWorkbook.Path & "\[" & strfilename & "]Sheet1'!$A$" & k
                .Range("B" & j).Formula = "='" & ThisWorkbook.Path & "\[" & strfilename & "]Sheet1'!$B$" & k
                .Range("C" & j).Formula = "='" & ThisWorkbook.Path & "\[" & strfilename & "]Sheet1'!$C$" & k
                k = k + 1
            Next j
        End With
    End If
Next strfilename

Sheet1.Columns("A:C").Value = Sheet1.Columns("A:C").Value
Set objfolder = Nothing
Application.ScreenUpdating = True
End Sub 


This code assumes the results and all source books are in a separate folder that does not contain any other irrelevant files

Try this code
Put your files into a folder named "Files" .. except the main workbook

Please Login or Register  to view this content.

error msg comes

script out of range "Set ws = mWB.Worksheets("Sheet1")"

as in all excel files sheet1 is not named as Sheet1

in all file sheet 1 is named with different numbers
like
5000
5007


likewise sheet1 in all workbooks are named with different numbers

@ sir jindon

I did not try to adjust it into your code but I think the bellow code can get the name of the sheet for code in post#11. It returns an array of worksheet names of the closed book (tested).(sample book attached as download from the web)

Please Login or Register  to view this content.

PHP Code: 

Option Explicit

Public Sub DemoGetSheetNames()

    Dim lNumEntries As Long
    Dim szFullName As String
    Dim szFileSpec As String
    Dim aszSheetList() As String
    
    Sheet1.UsedRange.Clear

    szFileSpec = "Excel Files (*.xl*),*.xl*"
    
    szFullName = CStr(Application.GetOpenFilename(szFileSpec, , "Select an Excel File"))
    
    ''' Continue if the user did not cancel the dialog.
    If szFullName <> CStr(False) Then
        GetSheetNames szFullName, aszSheetList()
        lNumEntries = UBound(aszSheetList) - LBound(aszSheetList) + 1
        Sheet1.Range("A1").Resize(lNumEntries).Value = Application.WorksheetFunction.Transpose(aszSheetList())
        Sheet1.Range("A1").EntireColumn.AutoFit
    End If

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Returns a string array containing the list of worksheets in
'''             the specified workbook.
'''             NOTE: Requires references to the following object library:
'''             * Microsoft ActiveX Data Objects 2.5 Library (or higher version)
'''
''' Arguments:  szFullName      [in] The full path and filename of the workbook
'''                             whose worksheet list you want to query.
'''             aszSheetList()  [out] Will be loaded with a list of worksheets
'''                             in the workbook specified by szFullName.
'''
''' Date        Developer       Action
''' --------------------------------------------------------------------------
''' 05/13/05    Rob Bovey       Created
'''
Private Sub GetSheetNames(ByRef szFullName As String, ByRef aszSheetList() As String)

    Dim bIsWorksheet As Boolean
    Dim objConnection As ADODB.Connection
    Dim rsData As ADODB.Recordset
    Dim lIndex As Long
    Dim szConnect As String
    Dim szSheetName As String

    Erase aszSheetList()
    If Application.Version < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & szFullName & ";Extended Properties=Excel 8.0;"
    Else
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & szFullName & ";Extended Properties=Excel 8.0;"
    End If

    Set objConnection = New ADODB.Connection
    objConnection.Open szConnect
    Set rsData = objConnection.OpenSchema(adSchemaTables)

    Do While Not rsData.EOF
        bIsWorksheet = False
        szSheetName = rsData.Fields("TABLE_NAME").Value
        If Right$(szSheetName, 1) = "$" Then
            ''' This is a simple sheet name. Remove the trailing "$" and continue.
            szSheetName = Left$(szSheetName, Len(szSheetName) - 1)
            bIsWorksheet = True
        ElseIf Right$(szSheetName, 2) = "$'" Then
            ''' This is a sheet name with spaces and/or special characters.
            ''' Remove the right "&'" characters.
            szSheetName = Left$(szSheetName, Len(szSheetName) - 2)
            ''' Remove the left single quote character.
            szSheetName = Right$(szSheetName, Len(szSheetName) - 1)
            bIsWorksheet = True
        End If
        If bIsWorksheet Then
            ''' Embedded single quotes in the sheet name will be doubled up.
            ''' Replace any doubled single quotes with one single quote.
            szSheetName = Replace$(szSheetName, "''", "'")
            ''' Load the processed sheet name into the array.
            ReDim Preserve aszSheetList(0 To lIndex)
            aszSheetList(lIndex) = szSheetName
            lIndex = lIndex + 1
        End If
        rsData.MoveNext
    Loop

    rsData.Close
    Set rsData = Nothing
    objConnection.Close
    Set objConnection = Nothing

End Sub