Hello Dostonus,
try this...
Put all excel files for extraction in one folder.
Run this code and navigate to that folder.
This code opens each file and loop through worksheets,
copying first row of each sheet to the new worksheet of the workbook with this code.
VBA Code:
Dim varLocation1 As String
Dim varNLoop As Long
Dim varFile, varArray
Dim varI As Integer
Dim varFSO, varOFile, varOFolder, varOFiles As Object
Dim varWB As Workbook, varWB2 As Workbook
Dim varCurrentRow As Long
Dim varWS As Worksheet
Sub ExtractTopRows()
MsgBox ("Select folder with excel files from where you want extraction.")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
varLocation1 = .SelectedItems(1)
Else
MsgBox ("Select folder with excel files from where you want extraction.")
Exit Sub
End If
End With
Sheets.Add
varFile = varListFiles(varLocation1 & "\")
Set varWB = ActiveWorkbook
Application.ScreenUpdating = False
For varNLoop = 1 To varI - 1
Workbooks.Open varLocation1 & "\" & varArray(varNLoop)
Set varWB2 = ActiveWorkbook
For Each varWS In varWB2.Worksheets
varWS.Activate
ActiveSheet.Rows(1).Copy
varWB.Activate
varCurrentRow = varCurrentRow + 1
Rows(varCurrentRow).PasteSpecial
Next varWS
Application.DisplayAlerts = False
varWB2.Close
Next
Set varFSO = Nothing
varCurrentRow = 0
Application.ScreenUpdating = True
End Sub
Function varListFiles(ByVal varPath As String)
Set varFSO = VBA.CreateObject("Scripting.FileSystemObject")
Set varOFolder = varFSO.GetFolder(varPath)
Set varOFiles = varOFolder.Files
If varOFiles.Count = 0 Then Exit Function
ReDim varArray(1 To varOFiles.Count)
varI = 1
For Each varOFile In varOFiles
varArray(varI) = varOFile.Name
varI = varI + 1
Next
End Function