Copy and paste Filename to left of data

Hello excel gurus,

I have a spreadsheet that copies and pastes data from excel spreadsheets within a directory. It can copy a set number of columns depending on the known files size. I have the problem, however, that the data is not labelled in any way, shape, or form. Here is the code.

Sub OpenSubfoldersFileUpdate()
Dim strFile As String
   Dim objFSO, destRow As Long
   Dim mainFolder, mySubFolder
   Set objFSO = CreateObject("Scripting.FileSystemObject")
    mFolder = Worksheets(1).Range("B12").Value
        If mFolder = 0 Then
        MsgBox " Address Missing"
        Else: Set mainFolder = objFSO.GetFolder(mFolder)
        End If
        For Each mySubFolder In mainFolder.subfolders
        strFile = Dir(mySubFolder & "\*.csv*")
        Do While strFile <> ""
            If Worksheets(1).Range("H12").Value = 0 _
            Then
            MsgBox "Missing Value!"
            End If
            If Worksheets(1).Range("H12").Value = 1 _
            Then
            Workbooks.Open mySubFolder & "\" & strFile
            Range("A2:AT2").Copy
            End If
            If Worksheets(1).Range("H12").Value = 2 _
            Then
            Workbooks.Open mySubFolder & "\" & strFile
            Range("A2:AT3").Copy
            End If
            If Worksheets(1).Range("H12").Value = 3 _
            Then
            Workbooks.Open mySubFolder & "\" & strFile
            Range("A2:AT4").Copy
            End If
            If Worksheets(1).Range("H12").Value = 4 _
            Then
            Workbooks.Open mySubFolder & "\" & strFile
            Range("A2:AT5").Copy
            End If
            If Worksheets(1).Range("H12").Value = 5 _
            Then
            Workbooks.Open mySubFolder & "\" & strFile
            Range("A2:AT6").Copy
            End If
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        erow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
        Worksheets("Sheet 1").Paste Destination:=Worksheets("Sheet 1").Cells(erow, 2)
        strFile = Dir
        Loop
    Next
End Sub

Is there any way I can copy and paste the actual filename to the left of the data that is already being copy/pasted?

Any help you guys can give would be most appreciated.

This gives the name of the macro file itself and not the name of the file from which the data was copied from.

Good idea though, I will maybe try to put it in at another point of the code.

I tried to change it

ActiveWorkbook.Name

to

strFile.Name

But it said it was an invalid command :/

Use this instead

Split(strFile,"\")(UBound(Split(strFile,"\")))

I put it in like this.

Worksheets("Sheet 1").Cells(erow, 1) = Split(strFile, "\")(UBound(Split(strFile, "\"))).Name

I get an "Object Required" error

I also tried it without the .Name and it gave an "Subscript out of Range" error.

I am very bad with vba I apologize if I used it wrong.

Oh, seems like strFile itself is already the file name. So just use this:

Worksheets("Sheet 1").Cells(erow, 1) = strFile

Thank you that worked. The only caveat is that it only pastes it once. Sometimes the data has 4 lines of data and it won't paste it in front of the next three lines, is there any way to accomplish that?

Try:

Worksheets("Sheet 1").Range(Cells(erow, 1), Worksheets("Sheet 1").Cells(Rows.Count, 2).End(xlUp).Offset(, -1)).Value = strFile

Another thing is, the way you are referencing the worksheet is very inconsistent, you have:
Worksheets(1)
Sheet1
Worksheets("Sheet 1")

Not that it is a problem now, but may cause error if your worksheet is no longer named "Sheet 1".

Thank you millz, I will make sure to make it more consistent. That fix worked perfectly.

This change solved the problem but I found that it only worked when I had the worksheet open. If I run it while on a different worksheet it gives me an application-defined or object-defined error.

Try this amended code:

Sub OpenSubfoldersFileUpdate()
    Dim strFile As String
    Dim objFSO, destRow As Long
    Dim mainFolder, mySubFolder
    Dim ws1, ws2 As Worksheet
    Set ws1 = Worksheets(1)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    mFolder = ws1.Range("B12").Value
    If mFolder = 0 Then
       MsgBox " Address Missing"
    Else: Set mainFolder = objFSO.GetFolder(mFolder)
    End If
    For Each mySubFolder In mainFolder.subFolders
        strFile = Dir(mySubFolder & "\*.csv*")
        Do While strFile <> ""
            If ws1.Range("H12").Value = 0 Then
               MsgBox "Missing Value!"
            ElseIf ws1.Range("H12").Value >= 1 And ws1.Range("H12").Value <= 5 Then
               Workbooks.Open mySubFolder & "\" & strFile
               Set ws2 = ActiveWorkbook.ActiveSheet
            End If
            If ws1.Range("H12").Value = 1 Then ws2.Range("A2:AT2").Copy
            If ws1.Range("H12").Value = 2 Then ws2.Range("A2:AT3").Copy
            If ws1.Range("H12").Value = 3 Then ws2.Range("A2:AT4").Copy
            If ws1.Range("H12").Value = 4 Then ws2.Range("A2:AT5").Copy
            If ws1.Range("H12").Value = 5 Then ws2.Range("A2:AT6").Copy
            Set ws2 = Nothing
            Application.DisplayAlerts = False
            
            erow = ws1.Cells(rows.Count, 2).End(xlUp).Offset(1, 0).row
            ws1.Paste Destination:=ws1.Cells(erow, 2)
            ws1.Range(Cells(erow, 1), ws1.Cells(rows.Count, 2).End(xlUp).Offset(, -1)).Value = strFile
            ActiveWorkbook.Close
            strFile = Dir
        Loop
    Next
End Sub