I have a ridiculous ancient spreadsheet that isn't made to pull reports from. I've already redone it for the future reports but unfortunately i have to go back and get info from the old ones.
Each workbook has 100+ worksheets, each worksheet named with the corresponding person's last name. I was able to create a loop to give me a list of the worksheet names in column a with the following code:
Columns 2 nd 3 i have an array formula to pull the first names and cost centers... then the rest of the columns are labeled 1 - 19, each of those representing activities. Each record consists of a project and how much time they spent on that project under the activities in the columns.![]()
Sub WorkSheetPull() dim i as Integer for i = 1 to worksheet.count Worksheets("Report").Cells(i, 1) = Worksheets(i).Name Next i End sub
Here's my problem.
I need a loop to go through each worksheet and search rows 18 thorugh 150, if the sum of the numbers in the row are >1 that means a value was entered on that row... and those numbers need to be pulled to the report spreadsheet....
I can't seem to put the code together correctlyHere are samples of some of my attempts:
![]()
Sub Records() Dim i As Integer Dim ws As Worksheet Dim Rw As Long Dim Cel, nRw, ac1 As Range Dim Projects As Range nRw = Worksheets("Project").Range("A65536").End(xlUp) For i = 3 To Worksheets.Count Worksheets("Projects").Cells(i, 1) = Worksheets(i).Name For Each ws In Worksheets Set Projects = Worksheets(i).Range("C18:C150") For Each Cel In Projects Rw = Application.CountA(Cel.EntireRow) If Rw > 1 Then Worksheets("projects").Cells(i, 4) = Worksheets(i).ac1.Value Loop Until Rw = 0 End Sub
This next one below actually worked perfectly but it only gives me the first record on the worksheet, i dont know how to get it to repeat the worksheet name on the next row of the report sheet if the employees sheet has more than one record. (Which it will for each month - see attached document)
I think i'm close but i can't wrap my head around this =( I just want the values in columns D through K and M through N if there's a value entered if not skip that row and go to the next until you get from row 18 to row 150 (some of the employees have 150 rows)....![]()
Sub ProjectPull1() 'Dim i, As Integer 'Dim R As Range For i = 2 To Worksheets.Count Worksheets("projects").Cells(i, 1) = Worksheets(i).Name If Not Worksheets(i).Range("C18") Is Nothing Then Worksheets("projects").Cells(i, 3) = Worksheets(i).Range("C18").Value End If If Not Worksheets(i).Range("D18") Is Nothing Then Worksheets("projects").Cells(i, 4) = Worksheets(i).Range("D18").Value End If If Not Worksheets(i).Range("E18") Is Nothing Then Worksheets("projects").Cells(i, 5) = Worksheets(i).Range("E18").Value End If If Not Worksheets(i).Range("F18") Is Nothing Then Worksheets("projects").Cells(i, 6) = Worksheets(i).Range("F18").Value End If If Not Worksheets(i).Range("G18") Is Nothing Then Worksheets("projects").Cells(i, 7) = Worksheets(i).Range("G18").Value End If If Not Worksheets(i).Range("H18") Is Nothing Then Worksheets("projects").Cells(i, 8) = Worksheets(i).Range("H18").Value End If If Not Worksheets(i).Range("i18") Is Nothing Then Worksheets("projects").Cells(i, 9) = Worksheets(i).Range("i18").Value End If If Not Worksheets(i).Range("J18") Is Nothing Then Worksheets("projects").Cells(i, 10) = Worksheets(i).Range("J18").Value End If If Not Worksheets(i).Range("K18") Is Nothing Then Worksheets("projects").Cells(i, 11) = Worksheets(i).Range("K18").Value End If If Not Worksheets(i).Range("M18") Is Nothing Then Worksheets("projects").Cells(i, 12) = Worksheets(i).Range("M18").Value End If If Not Worksheets(i).Range("N18") Is Nothing Then Worksheets("projects").Cells(i, 13) = Worksheets(i).Range("N18").Value End If Worksheets("projects").Cells(i, 14) = "=sum(RC4:RC13)" 'Column 2 = First name Next i End Sub
how should i proceed?
Bookmarks