Need a macro, which combines multiple excel sheets (csv format) from different folder and adds the name of the folder in a column of the excel sheet.

Basically, in path D:\ , i have the following folders
Maths, physics,Biology, English, French

Now i would place excel sheets belonging to each folder. The number of excel sheets can vary.
for the sake of convenience suppose we have 3 excel sheets in each folder.

Now the macro is to combine all the excel sheets from all the folders into a single excel sheet.
Problem comes that there is no way to distinguish between the excel sheets once they are combined.
So which picking up the data from each excel sheet, need to add the text " Math" or "physics" ( depending on the folder from which the excels are extraced) in a column at the end of the sheet.

Now I have a working macro that does all of the above.
however, i need to refine the logic or processing speed for this. As the total number of rows, after combining all the sheets can exceed 250000 rows. The current macro takes 20 minutes to process the data and provide output.

Can you please advise how i can reduce the time or a different logic that can reduce the time when dealing with these many rows of data?




Sub combine()
Dim Master As Workbook
Dim sourceData As Worksheet
'
Dim sourceBook As Workbook
Dim CurrentFileName As String
Dim myPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    


    myPath = "D:\combine\maths"
    CurrentFileName = Dir(myPath & "\*.csv")
Set Master = ThisWorkbook
Master.Sheets.Add.Name = "Master Sheet"
    Do

        Set sourceBook = Workbooks.Open(myPath & "\" & CurrentFileName)

        With sourceBook.ActiveSheet
            NoRows = .Range("H" & Rows.Count).End(xlUp).Row
            With .Cells(1, 33).Resize(NoRows)
                .Formula = "=if(H1="""","""",""maths"")"
                .Value = .Value
            End With
            .Range("A2:AK" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
                    Master.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End With

        sourceBook.Close (False)

        'Calling DIR w/o argument finds the next .xlsx file within the current directory.
        CurrentFileName = Dir()

    Loop While CurrentFileName <> ""
    

    myPath = "D:\combine\physics"
    CurrentFileName = Dir(myPath & "\*.csv")

    Do

        Set sourceBook = Workbooks.Open(myPath & "\" & CurrentFileName)

        With sourceBook.ActiveSheet
            NoRows = .Range("H" & Rows.Count).End(xlUp).Row
            With .Cells(1, 33).Resize(NoRows)
                .Formula = "=if(H1="""","""",""physics"")"
                .Value = .Value
            End With
            .Range("A2:AK" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
                    Master.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End With

        sourceBook.Close (False)

        'Calling DIR w/o argument finds the next .xlsx file within the current directory.
        CurrentFileName = Dir()

    Loop While CurrentFileName <> ""
    
   

    myPath = "D:\combine\biology"
    CurrentFileName = Dir(myPath & "\*.csv")

    Do

        Set sourceBook = Workbooks.Open(myPath & "\" & CurrentFileName)

        With sourceBook.ActiveSheet
            NoRows = .Range("H" & Rows.Count).End(xlUp).Row
            With .Cells(1, 33).Resize(NoRows)
                .Formula = "=if(H1="""","""",""biology"")"
                .Value = .Value
            End With
            .Range("A2:AK" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
                    Master.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End With

        sourceBook.Close (False)

        'Calling DIR w/o argument finds the next .xlsx file within the current directory.
        CurrentFileName = Dir()

    Loop While CurrentFileName <> ""
    
 

    myPath = "D:\combine\french"
    CurrentFileName = Dir(myPath & "\*.csv")

    Do

        Set sourceBook = Workbooks.Open(myPath & "\" & CurrentFileName)

        With sourceBook.ActiveSheet
            NoRows = .Range("H" & Rows.Count).End(xlUp).Row
            With .Cells(1, 33).Resize(NoRows)
                .Formula = "=if(H1="""","""",""french"")"
                .Value = .Value
            End With
            .Range("A2:AK" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
                    Master.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End With

        sourceBook.Close (False)


        CurrentFileName = Dir()

    Loop While CurrentFileName <> ""
        
        

    myPath = "D:\combine\english"
    CurrentFileName = Dir(myPath & "\*.csv")

    Do

        Set sourceBook = Workbooks.Open(myPath & "\" & CurrentFileName)

        With sourceBook.ActiveSheet
            NoRows = .Range("H" & Rows.Count).End(xlUp).Row
            With .Cells(1, 33).Resize(NoRows)
                .Formula = "=if(H1="""","""",""english"")"
                .Value = .Value
            End With
            .Range("A2:AK" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
                    Master.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End With

        sourceBook.Close (False)

        'Calling DIR w/o argument finds the next .xlsx file within the current directory.
        CurrentFileName = Dir()

    Loop While CurrentFileName <> ""
        
        
  
    
    
    
    
    

    MsgBox "Combined report Complete"

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True



End Sub