I have workbooks for each month. They all contain columns with date, tramline number and a delay reason. To specify the delay reason the row with the entry is colorcoded red or green.To search for specific tramline number and date across the workbooks i used the code below. It's perfect. But the result however comes back in a new sheet without the color code.
I tried to change the application.transpose command and had a look at the ws.cells.find command together with a IT pro from my company. But no one knows VBA.
the code I found which works perfectly without copying the color:
Sub test() Dim myDir As String, fn As String, ws As Worksheet, r As Range Dim a(), n As Long, x As Long, myTask As String, ff As String, temp myDir = "c:\test\" '<- change here If Dir(myDir, 16) = "" Then MsgBox "No such foloder path", 64, myDir Exit Sub End If myTask = InputBox("Enter Task number") If myTask = "" Then Exit Sub x = Columns.Count fn = Dir(myDir & "*.xls*") With Application .ScreenUpdating = False .EnableEvents = False End With Do While fn <> "" With Workbooks.Open(myDir & fn, 0) For Each ws In .Worksheets Set r = ws.Cells.Find(myTask, , , 1) If Not r Is Nothing Then ff = r.Address Do n = n + 1 temp = r.EntireRow.Value Redim Preserve temp(1 To 1, 1 To x) Redim Preserve a(1 To n) a(n) = temp Set r = ws.Cells.FindNext(r) Loop While ff <> r.Address End If Next .Close False End With fn = Dir Loop With ThisWorkbook.Sheets(1).Rows(1) .CurrentRegion.ClearContents If n > 0 Then .Resize(n).Value = _ Application.Transpose(Application.Transpose(a)) Else MsgBox "Not found", , myTask End If End With