Need help with a Directory Macro

[copleyr]

Hello,

Below I have a macro that will go into a folder and pull the names of the excel files.

1) I now need a macro that will go into the "Defaults" tab of each of these files and copy row 70 (columns "A" through "BM") and paste it into a blank sheet.

There could be 100 files in this folder. Is there a way to do this?

Many thanks in advance!

Sub ListFiles()
Dim MyPathName As String
Dim MyFileName As String
Dim NumChars As Long
Dim X As Long
    NumChars = 6 'Change this to the number of characters you wish to return
    MyPathName = "C:\Program Files\excel files_folder\*.xl*" 'Change this to the folder and filetypes you want to return
    MyFileName = Dir(MyPathName)
    Do While MyFileName <> ""
        X = X + 1
        Sheet1.Cells(X, 1) = Left(MyFileName, NumChars)
        MyFileName = Dir
    Loop
End Sub

 

[copleyr]

Could you have a macro that opens each file? Would that take a while?

 

[copleyr]

Is this macro impossible to do?

 

[Blade Hunter]

So you want A70:BM70 from every sheet copied one after the other in to a single sheet like a summary yes?

 

[copleyr]

exactly

 

[Blade Hunter]

Again, I am free typing this so it may have errors, please report back.

Option Explicit
Sub SumariseFiles()
Dim MyPathName As String
Dim MyFileName As String
Dim NumChars As Long
Dim X As Long
Dim SummarySheet As Workbook
Workbooks.Add
SummarySheet = ActiveWorkbook
MyPathName = "C:\Program Files\excel files_folder\*.xl*" 'Change this to the folder and filetypes you want to return
MyFileName = Dir(MyPathName)
Do While MyFileName <> ""
    X = X + 1
    Workbooks.Open (MyPathName & MyFileName)
    SummarySheet.Activate
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1 & ":BM" & Range("A" & Rows.Count).End(xlUp).Row + 1) = Application.Transpose(Application.Transpose(Workbooks(MyFileName).Sheets(1).Range("A70:BM70")))
    Workbooks(MyFileName).Close False
    MyFileName = Dir
Loop
End Sub

 

[copleyr]

Thank you so much for the quick turnaround. I got a Run-time error '91': object variable or with block variable not set.

it pointed at this line:

SummarySheet = ActiveWorkbook

Any ideas?

 

[Blade Hunter]

Can't remember how to put the book to a variable properly, this workaround should fix that error:

Sub SummeriseFiles()
Dim MyPathName As String
Dim MyFileName As String
Dim NumChars As Long
Dim X As Long
Dim SummarySheet As String
Workbooks.Add
SummarySheet = ActiveWorkbook.Name
MyPathName = "C:\Program Files\excel files_folder\*.xl*" 'Change this to the folder and filetypes you want to return
MyFileName = Dir(MyPathName)
Do While MyFileName <> ""
    X = X + 1
    Workbooks.Open (MyPathName & MyFileName)
    Workbooks(SummarySheet).Activate
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1 & ":BM" & Range("A" & Rows.Count).End(xlUp).Row + 1) = Application.Transpose(Application.Transpose(Workbooks(MyFileName).Sheets(1).Range("A70:BM70")))
    Workbooks(MyFileName).Close False
    MyFileName = Dir
Loop
End Sub

 

[copleyr]

How to I get it to go to the "Defaults" tab in the file and copy the rows? "Defaults" is the name of the tab.

It is going into the files but it doesn't seem to go to the "Defaults" tab to copy. Nothing ends up being copied.

Any ideas?

Thanks again.

 

[Blade Hunter]

Silly me, I forgot that bit.

5th Last line of code (the really long one)

Change this:

.Sheets(1).Range("A70:BM70")))

To this:

.Sheets("Defaults").Range("A70:BM70")))

In other words change the 1 to "Defaults"