T
Theo
This macor works great - but I only want to copy Row 2. ****HERE****
Can someone help?
Thanks
T
Sub Master()
Dim myBook As Workbook
Dim myCalc As XlCalculation
Dim myShtName As String
With Application
.EnableEvents = False
.DisplayAlerts = False
myCalc = .Calculation
.Calculation = xlCalculationManual
End With
On Error Resume Next
With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "H:\WR Intake"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets(1).Range("A2").CurrentRegion.Copy _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2)
*****Don't want everything - just row 2 ***********
myBook.Close False
Next i
Else: MsgBox "There were no files found."
End If
End With
With Application
.EnableEvents = True
.DisplayAlerts = True
.Calculation = myCalc
End With
End Sub
Can someone help?
Thanks
T
Sub Master()
Dim myBook As Workbook
Dim myCalc As XlCalculation
Dim myShtName As String
With Application
.EnableEvents = False
.DisplayAlerts = False
myCalc = .Calculation
.Calculation = xlCalculationManual
End With
On Error Resume Next
With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "H:\WR Intake"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets(1).Range("A2").CurrentRegion.Copy _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp)(2)
*****Don't want everything - just row 2 ***********
myBook.Close False
Next i
Else: MsgBox "There were no files found."
End If
End With
With Application
.EnableEvents = True
.DisplayAlerts = True
.Calculation = myCalc
End With
End Sub