Log Data from excel employee timesheet

[keith6292]

I am extremely new with macros and i was hoping someone could help me solve this issue of mine.

I would like to be able to log the data from my employees timesheet into a register. Please see my example.

I want the data I highlighted in "Orange" to copy over to the "Example Log" when i click the button "Log Data"

7338.Time.Tracking.xlsm

[walruseggman]

Sub keith6292()
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "AI").End(xlUp).Row
OpenRow = LastRow + 1
i = 2
Do

If OpenRow > 23 Then
Range("AI" & OpenRow - 1 & ":AM" & OpenRow - 1).Copy
Range("AI" & OpenRow & ":AM" & OpenRow).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End If

Range("AI" & OpenRow).Value = Range("M4").Value
Range("AJ" & OpenRow).Value = Cells(7, i).Value
Range("AK" & OpenRow).Value = Range("X2").Value
Range("AL" & OpenRow).Value = Cells(33, i).Value
Range("AM" & OpenRow).Value = Cells(33, i + 1).Value
OpenRow = OpenRow + 1
i = i + 2

Loop While Cells(7, i) <> ""
Application.ScreenUpdating = True
End Sub

[keith6292]

Hey, that works perfect. Just one more thing, that table that says "Example Log", I will be moving that to a sheet called "Ticket Register". so what will i have to change in the code to make that work?

Thanks in advance.

[walruseggman]

Assuming data goes into columns A-E on Ticket Register. Adjust as necessary.

Sub keith6292()
Application.ScreenUpdating = False
Set ws1 = Worksheets("Time Sheet")
Set ws2 = Worksheets("Ticket Register")
LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
OpenRow = LastRow + 1
i = 2
Do

If OpenRow > 23 Then
ws2.Range("A" & OpenRow - 1 & ":E" & OpenRow - 1).Copy
ws2.Range("A" & OpenRow & ":E" & OpenRow).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End If

ws2.Range("A" & OpenRow).Value = ws1.Range("M4").Value
ws2.Range("B" & OpenRow).Value = ws1.Cells(7, i).Value
ws2.Range("C" & OpenRow).Value = ws1.Range("X2").Value
ws2.Range("D" & OpenRow).Value = ws1.Cells(33, i).Value
ws2.Range("E" & OpenRow).Value = ws1.Cells(33, i + 1).Value
OpenRow = OpenRow + 1
i = i + 2

Loop While ws1.Cells(7, i) <> ""
Application.ScreenUpdating = True
End Sub

[keith6292]

Works perfect. Thanks so much for your help.

[walruseggman]

Great! Please mark this thread as SOLVED, and any reputation points (the * in the lower left of my posts) is appreciated.