Copy a row from 3000 excel files stored in a folder and paste it in a new workbook

Hi,

Here's my situation:

I have 3000 workbooks in a folder.
Each has a worksheet named "Sheet1"
There are 13 colums and 2 rows of data in Sheet1.

I need to copy the second row from all excel files stored in the folder and
paste them into a blank workbook.

I really do not know how to proceed with this. I have basic VBA knowledge.

Thank you very much for any advice, I will greatly appreciate it.

The following should do as you require. Note that you will need to set the folder to look in appropriately.
This code should be placed into a module in the VBE.

Option Explicit

Sub Get_the_rows()

Const FOLDER_TO_LOOK_IN = "C:\My Excel Files"

Dim Input_Path As String, Input_File As String
Dim Output_Row As Long
Dim input_wb As Workbook, input_ws As Worksheet
Dim oldCalcMethod As Long

If Right(FOLDER_TO_LOOK_IN, 1) <> "\" Then
    Input_Path = FOLDER_TO_LOOK_IN & "\"
Else
    Input_Path = FOLDER_TO_LOOK_IN
End If

Application.ScreenUpdating = False
oldCalcMethod = Application.Calculation
Application.Calculation = xlCalculationManual

With Worksheets(1)
    Output_Row = .UsedRange.Rows.Count + 1
    If Output_Row = 2 And WorksheetFunction.CountA(.Rows(1)) = 0 Then Output_Row = 1
    
    Input_File = Dir(Input_Path & "*.xls")
    Do While Input_File <> "" And Output_Row < .Rows.Count
        On Error Resume Next
        Set input_wb = Nothing
        Set input_wb = Workbooks.Open(Input_Path & Input_File)
        If Not input_wb Is Nothing Then
            Set input_ws = Nothing
            Set input_ws = input_wb.Worksheets("Sheet1")
            If Not input_ws Is Nothing Then
                input_ws.Rows(2).Copy Destination:=.Rows(Output_Row)
                Output_Row = Output_Row + 1
            End If
        End If
        input_wb.Close savechanges:=False
        Input_File = Dir()
        On Error GoTo 0
    Loop
End With
Application.ScreenUpdating = True
Application.Calculation = oldCalcMethod
MsgBox "Complete"
End Sub

Sorry, I would normally comment the code for posters to learn from, but I was rushed when posting this

Here it is with some comments. Any other questions feel free to ask

' This makes Excel REQUIRE you to DIM each variable before you use it.
Option Explicit

Sub Get_the_rows()

' Define a constant detailing which folder to look in
Const FOLDER_TO_LOOK_IN = "C:\My Excel Files"

' Define the variables we are going to use
Dim Input_Path As String, Input_File As String
Dim Output_Row As Long
Dim input_wb As Workbook, input_ws As Worksheet
Dim oldCalcMethod As Long

' Make sure that the folder to look in ends with the '\' character. If not then add it.
If Right(FOLDER_TO_LOOK_IN, 1) <> "\" Then
    Input_Path = FOLDER_TO_LOOK_IN & "\"
Else
    Input_Path = FOLDER_TO_LOOK_IN
End If

' Switch off ScreenUpdating and set the calculation method to manual.
' This speeds up Excel and will stop the screen flickering
Application.ScreenUpdating = False
oldCalcMethod = Application.Calculation
Application.Calculation = xlCalculationManual

' With the first worksheet in our workbook.
With Worksheets(1)
    ' Store the row number of the last used row, +1...
    Output_Row = .UsedRange.Rows.Count + 1
    ' ...if that puts you on row 2 then check whether row 1 is blank, if it is use row 1 instead.
    If Output_Row = 2 And WorksheetFunction.CountA(.Rows(1)) = 0 Then Output_Row = 1
    
    ' Look for a file in the directory, that is an ".xls" file
    Input_File = Dir(Input_Path & "*.xls")
    
    ' If there was a file, 'Input_File' will now have that name, otherwise it will be empty (ie. "")
    ' So while we have a name, and we have space left to put the results, do a loop of the following commands
    Do While Input_File <> "" And Output_Row < .Rows.Count
        
        ' If we encounter an error, (such as no 'Sheet1' in the XLS file), just carry on
        On Error Resume Next
        
        ' Set 'input_wb' to Nothing, then try to open the first XLS file, and set input_wb to it..
        Set input_wb = Nothing
        Set input_wb = Workbooks.Open(Input_Path & Input_File)
        
        ' If the file didn't open properly then "input_wb" will still be 'Nothing', otherwise do the following code.
        If Not input_wb Is Nothing Then
        
            ' Set 'input_ws' to Nothing, then try to set it to a worksheet named "Sheet1"..
            Set input_ws = Nothing
            Set input_ws = input_wb.Worksheets("Sheet1")
            
            ' If there is no "Sheet1" then input_ws will still be nothing, otherwise do the following code.
            If Not input_ws Is Nothing Then
            
                ' Select row 2 of the worksheet, and copy it to the first empty row on the 'summary' worksheet
                input_ws.Rows(2).Copy Destination:=.Rows(Output_Row)
                
                ' As we have now used a row on the summary worksheet, increment the 'empty row' marker
                Output_Row = Output_Row + 1
            End If
        End If
        
        ' Close the file we copied the row from, but don't save any changes, (not that we made any to it, but just in case!).
        input_wb.Close savechanges:=False
        
        ' Set Input_File to the next ".xls" file, (or to "" if there are no more)
        Input_File = Dir()
        On Error GoTo 0
    
    ' Go back to the start of the loop, (where we check to see if 'Input_File' is a name, or "")
    Loop
End With

' Switch the screen updating back on, and restore whatever calculation method the user had before we ran the macro.
Application.ScreenUpdating = True
Application.Calculation = oldCalcMethod

' tell the user we are complete
MsgBox "Complete"
End Sub

I think the following change should do it for you:

From:

                ' Select row 2 of the worksheet, and copy it to the first empty row on the 'summary' worksheet
                input_ws.Rows(2).Copy Destination:=.Rows(Output_Row)

To:

                ' Select row 2 of the worksheet, and copy just the values to the first empty row on the 'summary' worksheet
                input_ws.Rows(2).Copy
                .Rows(Output_Row).PasteSpecial Paste:=xlPasteValues

Hope that helps