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:
Sub WorkSheetPull()
dim i as Integer
for i = 1 to worksheet.count
Worksheets("Report").Cells(i, 1) = Worksheets(i).Name
Next i
End sub
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.
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 correctly
Here 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)
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
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)....
how should i proceed?
Bookmarks