Need Help with Macro Please

excel_love

New Member
Joined
May 2, 2013
Messages
10
Hi,
I am developing a labor tracking spreadsheet for my employer. The labor needs to be tracked for each product and for every employee by day.

I created a spreadsheet, where I have a maximum of 31 Spread sheets titled "Day 1, Day 2 ....Day 31".

The values on every spreadsheet are located in the same place.

The end report needs to show values in the below format

Product # Department Hours



There are 14 departments and as many as 40 products that might have to be tracked on a daily basis.


On each sheet at the bottom I have summarized each department's labor hours for each Product #

The Product Number is listed in Cells (E315, H315, K315, N315.....GO315)

The department numbers are listed from (E316:E328, H316:H328, K316:K328, N316:N328.....GO316:GO328)

The labor hours for the respective departments are listed from (G316:G328, J316:J328, M316:M328, P316:P328 .....GQ316:GQ328)

Depending on production employees can be working on the same product number for days.

I tried to do the record macro and manually lookup these values, but it is time consuming.

I was wondering if any1 here can please point me in the right direction. Please let me know if you have any questions. Thank You for your help
 
Got to the link that way. Below is just a copy of the code you posted with indentation and in a code block:
Code:
Sub Summary()
    Dim WkSht As Worksheet
    Dim r As Integer
    
    For Each WkSht In ThisWorkbook.Worksheets
        If WkSht.Name <> "DAILY" Then
            For r = 1 To 1000
                'This will check the first 1000 rows of each sheet
                If WkSht.Range("A" & r).Value = Sheets("DAILY").Range("B1").Value _
                    And WkSht.Range("B" & r).Value = Sheets("DAILY").Range("F1").Value Then
                    
                    WkSht.Rows(r & ":" & r).Copy
                    Sheets("DAILY").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
                    Sheets("DAILY").Range("B" & Sheets("DAILY").Range("A65536").End(xlUp).Row).Value = WkSht.Name
                    'Puts the machine name in column B
                End If
            Next r
        End If
    Next WkSht
End Sub
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Got to the link that way. Below is just a copy of the code you posted with indentation and in a code block:
Code:
Sub Summary()
    Dim WkSht As Worksheet
    Dim r As Integer
    
    For Each WkSht In ThisWorkbook.Worksheets
        If WkSht.Name <> "DAILY" Then
            For r = 1 To 1000
                'This will check the first 1000 rows of each sheet
                If WkSht.Range("A" & r).Value = Sheets("DAILY").Range("B1").Value _
                    And WkSht.Range("B" & r).Value = Sheets("DAILY").Range("F1").Value Then
                    
                    WkSht.Rows(r & ":" & r).Copy
                    Sheets("DAILY").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
                    Sheets("DAILY").Range("B" & Sheets("DAILY").Range("A65536").End(xlUp).Row).Value = WkSht.Name
                    'Puts the machine name in column B
                End If
            Next r
        End If
    Next WkSht
End Sub


Thank You....any tips on how I can make this work?
 
Upvote 0
I was able to record the code below. I need to be able to repeat this for multiple sheets. If you can please help me with this, that would be great. Thank You


Code:
Sub Macro1()
'
' Macro1 Macro
'


'
    Sheets("MAIN TEMPLATE").Select
    Sheets.Add
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Summary"
    Sheets("Day 1").Select
    Range("B544:B557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("B2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "PDI"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "AXLE R & R"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "ENGINE R & R"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "ENGINE DRESSING"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "AXLE DRESSING"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "PAINT & BODY"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "INTERIOR"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "CLEAN"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "BLDG & GROUNDS"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "EXT BODY"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "ELECTRICAL"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "TOOL CRIB"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "BLDG & GROUNDS"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "SHOP OFFICE"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "WAREHOUSE"
    Range("B2:O2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Size = 10
    Selection.Font.Size = 9
    Selection.Font.Size = 8
    Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B2:O2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "BUS #"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "='Day 1'!R[537]C[1]"
    Range("B5").Select
    Sheets("Day 1").Select
    Range("D544:D557").Select
    Selection.Copy
    Sheets("Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A6").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[536]C[4]"
    Range("B6").Select
    Sheets("Day 1").Select
    Range("G544:G557").Select
    Selection.Copy
    Sheets("Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A7").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[535]C[7]"
    Range("A8").Select
    Sheets("Day 1").Select
    Range("J544:J557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A8").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[534]C[10]"
    Range("A9").Select
    Sheets("Day 1").Select
    Range("M544:M557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A9").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[533]C[13]"
    Range("A10").Select
    Sheets("Day 1").Select
    ActiveWindow.Zoom = 90
    ActiveWindow.Zoom = 80
    ActiveWindow.Zoom = 70
    Range("P544:P557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A10").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[532]C[16]"
    Range("A11").Select
    Sheets("Day 1").Select
    Range("S544:S557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A11").Select
    Application.CutCopyMode = False
    Sheets("Summary").Select
    ActiveCell.FormulaR1C1 = "='Day 1'!R[531]C[19]"
    Range("A12").Select
    Sheets("Day 1").Select
    ActiveWindow.SmallScroll ToRight:=19
    Range("V544:V557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A12").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[530]C[22]"
    Range("A13").Select
    Sheets("Day 1").Select
    Range("Y544:Y557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A13").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[529]C[25]"
    Range("A14").Select
    Sheets("Day 1").Select
    Range("AB544:AB557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A14").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[528]C[28]"
    Range("A15").Select
    Sheets("Day 1").Select
    Range("AE544:AE557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B14").Select
    Range("B14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A15").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[527]C[31]"
    Range("A16").Select
    Sheets("Day 1").Select
    Range("AH544:AH557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A16").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[526]C[34]"
    Range("A17").Select
    Sheets("Day 1").Select
    Range("AK544:AK557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A17").Select
    Sheets("Summary").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[525]C[37]"
    Range("A18").Select
    Sheets("Day 1").Select
    ActiveWindow.SmallScroll ToRight:=18
    Range("AN544:AN557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A18").Select
    Application.CutCopyMode = False
    Sheets("Summary").Select
    ActiveCell.FormulaR1C1 = "='Day 1'!R[524]C[40]"
    Range("A19").Select
    Sheets("Day 1").Select
    Range("AQ544:AQ557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A19").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[523]C[43]"
    Range("A20").Select
    Sheets("Day 1").Select
    Range("AT544:AT557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A20").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[522]C[46]"
    Range("A21").Select
    Sheets("Day 1").Select
    Range("AW544:AW557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B20").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A21").Select
    Sheets("Summary").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[521]C[49]"
    Range("A22").Select
    Sheets("Day 1").Select
    Range("AZ544:AZ557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A22").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[520]C[52]"
    Range("A23").Select
    Sheets("Day 1").Select
    Range("BC544:BC557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B22").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A23").Select
    Sheets("Summary").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[519]C[55]"
    Range("A24").Select
    Sheets("Day 1").Select
    Range("BF544:BF557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A24").Select
    Application.CutCopyMode = False
    Sheets("Summary").Select
    ActiveCell.FormulaR1C1 = "='Day 1'!R[518]C[58]"
    Range("A25").Select
    Sheets("Day 1").Select
    ActiveWindow.SmallScroll ToRight:=21
    Range("BI544:BI557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A25").Select
    Sheets("Summary").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[517]C[61]"
    Range("A26").Select
    Sheets("Day 1").Select
    Range("BL544:BL557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B25").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A26").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[516]C[64]"
    Range("A27").Select
    Sheets("Day 1").Select
    Range("BO544:BO557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A27").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[515]C[67]"
    Range("A28").Select
    Sheets("Day 1").Select
    Range("BR544:BR557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A28").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[514]C[70]"
    Range("A29").Select
    Sheets("Day 1").Select
    Range("BU544:BU557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B28").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A29").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[513]C[73]"
    Range("A30").Select
    Sheets("Day 1").Select
    Range("BX544:BX557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B29").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    ActiveWindow.SmallScroll Down:=3
    Sheets("Summary").Select
    Range("A30").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[512]C[76]"
    Range("A31").Select
    Sheets("Day 1").Select
    Range("CA544:CA557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Day 1").Select
    ActiveWindow.SmallScroll ToRight:=21
    Sheets("Summary").Select
    Range("A31").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[511]C[79]"
    Range("A32").Select
    Sheets("Day 1").Select
    Range("CD544:CD557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    ActiveWindow.SmallScroll Down:=6
    Range("A32").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[510]C[82]"
    Range("A33").Select
    Sheets("Day 1").Select
    Range("CG544:CG557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B32").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A33").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[509]C[85]"
    Range("A34").Select
    Sheets("Day 1").Select
    Range("CJ544:CJ557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B33").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A34").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[508]C[88]"
    Range("A35").Select
    Sheets("Day 1").Select
    Range("CM544:CM557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B34").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A35").Select
    Sheets("Summary").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[507]C[91]"
    Range("A36").Select
    Sheets("Day 1").Select
    Range("CP544:CP557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B35").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A36").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[506]C[94]"
    Range("A37").Select
    Sheets("Day 1").Select
    Range("CS544:CS557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B36").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A37").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[505]C[97]"
    Range("A38").Select
    Sheets("Day 1").Select
    Range("CV544:CV557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B37").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Day 1").Select
    ActiveWindow.SmallScroll ToRight:=21
    Sheets("Summary").Select
    Range("A38").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[504]C[100]"
    Range("A39").Select
    Sheets("Day 1").Select
    Range("CY544:CY557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B38").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    ActiveWindow.SmallScroll Down:=15
    Range("A39").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[503]C[103]"
    Range("A40").Select
    Sheets("Day 1").Select
    Range("DB544:DB557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B39").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A40").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[502]C[106]"
    Range("A41").Select
    Sheets("Day 1").Select
    Range("DE544:DE557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B40").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A41").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[501]C[109]"
    Range("A42").Select
    Sheets("Day 1").Select
    Range("DH544:DH557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A42").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[500]C[112]"
    Range("A43").Select
    Sheets("Day 1").Select
    Range("DK544:DK557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B42").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A43").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[499]C[115]"
    Range("A44").Select
    Sheets("Day 1").Select
    Range("DN544:DN557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B43").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A44").Select
    Sheets("Summary").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[498]C[118]"
    Range("A45").Select
    Sheets("Day 1").Select
    Range("DQ544:DQ557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B44").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Day 1").Select
    ActiveWindow.SmallScroll ToRight:=21
    Sheets("Summary").Select
    Range("A45").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[497]C[121]"
    Range("A46").Select
    Sheets("Day 1").Select
    Range("DT544:DT557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B45").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A46").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[496]C[124]"
    Range("A47").Select
    Sheets("Day 1").Select
    Range("DW544:DW557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B46").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A47").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[495]C[127]"
    Range("A48").Select
    Sheets("Day 1").Select
    Range("DZ544:DZ557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B47").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A48").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[494]C[130]"
    Range("A49").Select
    Sheets("Day 1").Select
    Range("EC544:EC557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A49").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[493]C[133]"
    Range("A50").Select
    Sheets("Day 1").Select
    Range("EF544:EF557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B49").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A50").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[492]C[136]"
    Range("A51").Select
    Sheets("Day 1").Select
    Range("EI544:EI557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B50").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A51").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[491]C[139]"
    Range("A52").Select
    Sheets("Day 1").Select
    Range("EL544:EL557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B51").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Day 1").Select
    ActiveWindow.SmallScroll ToRight:=21
    Sheets("Summary").Select
    Range("A52").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[490]C[142]"
    Range("A53").Select
    Sheets("Day 1").Select
    Range("EO544:EO557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B52").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    ActiveWindow.SmallScroll Down:=15
    Range("A53").Select
    Sheets("Summary").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[489]C[145]"
    Range("A54").Select
    Sheets("Day 1").Select
    Range("ER544:ER557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B53").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A54").Select
    Sheets("Summary").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[488]C[148]"
    Range("A55").Select
    Sheets("Day 1").Select
    Range("EU544:EU557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B54").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Summary").Select
    Range("A55").Select
    Application.CutCopyMode = False
    Sheets("Summary").Select
    ActiveCell.FormulaR1C1 = "='Day 1'!R[487]C[151]"
    Range("A56").Select
    Sheets("Day 1").Select
    Range("EX544:EX557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B55").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A56").Select
    Sheets("Day 1").Select
    Range("EO558").Select
    Sheets("Summary").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[486]C[154]"
    Range("A57").Select
    Sheets("Day 1").Select
    Range("FA544:FA557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B56").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A57").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[485]C[157]"
    Range("A58").Select
    Sheets("Day 1").Select
    Range("FD544:FD557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B57").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A58").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[484]C[160]"
    Range("A59").Select
    Sheets("Day 1").Select
    Range("FG544:FG557").Select
    Selection.Copy
    Range("EN558").Select
    Sheets("Summary").Select
    Range("B58").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A58").Select
    Sheets("Day 1").Select
    ActiveWindow.SmallScroll ToRight:=21
    Sheets("Summary").Select
    Range("A59").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[483]C[163]"
    Range("A60").Select
    Sheets("Day 1").Select
    Range("FJ544:FJ557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B59").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A60").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = "='Day 1'!R[482]C[166]"
    Range("A61").Select
    Sheets("Day 1").Select
    Range("FM544:FM557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B60").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A61").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[481]C[169]"
    Range("A62").Select
    Sheets("Day 1").Select
    Range("FP544:FP557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B61").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A62").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[480]C[172]"
    Range("A63").Select
    Sheets("Day 1").Select
    Range("FS544:FS557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B62").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A63").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[479]C[175]"
    Range("A64").Select
    Sheets("Day 1").Select
    Range("FV544:FV557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B63").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A64").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[478]C[178]"
    Range("A65").Select
    Sheets("Day 1").Select
    Range("FY544:FY557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B64").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A65").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[477]C[181]"
    Range("A66").Select
    Sheets("Day 1").Select
    Range("GB544:GB557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B65").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Day 1").Select
    ActiveWindow.SmallScroll ToRight:=16
    Sheets("Summary").Select
    Range("A66").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[476]C[184]"
    Range("A67").Select
    Sheets("Day 1").Select
    Range("GE544:GE557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B66").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A67").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[475]C[187]"
    Range("A68").Select
    Sheets("Day 1").Select
    Range("GH544:GH557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B67").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A68").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[474]C[190]"
    Range("A69").Select
    Sheets("Day 1").Select
    Range("GK544:GK557").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B68").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A69").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "='Day 1'!R[473]C[193]"
    Range("A70").Select
    Sheets("Day 1").Select
    Range("GN544:GN557").Select
    Selection.Copy
    Sheets("Summary").Select
    ActiveWindow.SmallScroll Down:=3
    Range("B69").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
End Sub
 
Upvote 0
First step is to clean up the recorded code so that it will run faster and be able to be read. The recorder sprinkles the code with .Select and .Activate methods that are not needed and slow everything down. The recorder isn't perfect and need 'intervention'. As an example:
Code:
    Sheets("Day 1").Select
    Range("GK544:GK557").Select
    Selection.Copy
Should become:
Code:
    Sheets("Day 1").Range("GK544:GK557").Copy
I will not be able to do more for you until Monday afternoon.
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top