VBA code to paste one value the number of times specified in a cell

Hi All!
Helps please...
I am creating a custom timesheet in Excel but upon submission I'm trying to paste the Employee name into the 'submissions' tab only as many times as there are filled out lines in the timesheet. I have a feeling the solution is quite simple...
Here's my code snippet so far:

    
'find the number of entries and set value as number of times to paste the employee name
    Range("K10").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -5).Select
    
    'how do I set the number in this cell (in this case, line 4) as the number of times to paste the value?
    
'Copy the Employee Name
    Range("EEName").Select
    Selection.Copy
    Sheets("Submissions").Select
    
'Find the first blank cell in column A
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    FirstBlankCell.Activate

'Paste the data in as many times as there are entries
    
    With Range(FirstBlankCell, "A" & lastrow&).Select
    Selection.PasteSpecial xlValues '***as many times as found in ActiveCell.Offset(0,-5).Select above
    
    End With

Any pointing me in the right direction is greatly appreciated! :confused:

Where does the timesheet data start and how is it laid out?

Where exactly do you want to put the employee name?

Can you upload an example workbook with dummy data?

I'm locked down pretty tight here at work so I can't upload anything, but I can paste more code and describe a little furhter:

All data entry fields on the timesheet are named ranges.

Columns are set up as follows:
Line Project Phase Task Description Priority Sun Mon Tue Wed Thu Fri Sat Hrs per PPT
1
2
3
4
5

If lines 1 through 4 have data entered I want the macro to see that it should copy & paste the employee name (in named EEName range) into the submissions tab into the next 4 blank rows in column A.

Here's the whole pile 'o' code:
(I have various letters of the alphabet for each section because everything was added in stages for this project and I was having a hard time keeping track of where I was... still a noob at this)

Sub Submit()
'
' Submit Macro
' Copies Time Sheet data to the Submissions tab, clears data that has successfully copied.
'
Application.ScreenUpdating = False

Range("TotalHrs").Select

'***********BEFORE ALLOWING THE USER TO SUBMIT************************************************

'Check to make sure the Priority column has been populated for all entries
    Dim c As Range
    Dim d As Range
    Dim e As Range
    Dim f As Range
    Dim DataRange As Range
    
    
    For Each c In Range("Priority")
        Set DataRange = Range(Cells(c.Row, 4), Cells(c.Row, 8))
        If Application.WorksheetFunction.CountBlank(DataRange) = 1 _
        And IsEmpty(Cells(c.Row, 11)) Then
            MsgBox "Missing Priority on line " & c.Row - 9, , "Missing Data"
            Exit Sub
        End If

'Check to make sure if Priority has been filled out that there is a Project/Phase or Task
        Set DataRange = Range(Cells(c.Row, 4), Cells(c.Row, 8))
        If Application.WorksheetFunction.CountA(DataRange) = 0 _
        And Len(Cells(c.Row, 11)) > 0 Then
            MsgBox "Missing Project, Phase or Task on line " & c.Row - 9, , "Missing Data"
            Exit Sub
        End If
         
    Next c


'check to make sure there is only one Project or Task chosen on each line
For Each c In Range("Task")
        Set DataRange = Range(Cells(c.Row, 8), Cells(c.Row, 8))
        If Application.WorksheetFunction.CountBlank(DataRange) = 0 _
        And (Cells(c.Row, 4)) > 0 Then
            MsgBox "Only one Project/Phase or Task can be chosen per line. See entry #" & c.Row - 9, vbExclamation, "Oops!"
            Exit Sub
        End If
    
    Next c
    
For Each d In Range("Project")
        Set DataRange = Range(Cells(d.Row, 4), Cells(d.Row, 4))
        If Application.WorksheetFunction.CountBlank(DataRange) = 0 _
        And (Cells(d.Row, 8)) <> "" Then
            MsgBox "Only one Project/Phase or Task can be chosen per line. Check row #" & d.Row, vbExclamation, "Oops!"
            Exit Sub
        End If
         
    Next d
    
    
'check that there are hours entered for each line using priority column as reference
    For Each e In Range("Hrs")
        Set DataRange = Range(Cells(e.Row, 20), Cells(e.Row, 20))
        If DataRange.Value = "" _
        And (Cells(e.Row, 11)) <> "" Then
                    MsgBox "Missing Hours on line " & e.Row - 9, , "Missing Data"
            Exit Sub
        End If
         
    Next e
    
'check that there is either a project or a task entered for each line using priority column as reference
    For Each f In Range("Task")
        Set DataRange = Range(Cells(f.Row, 8), Cells(f.Row, 8))
        If Application.WorksheetFunction.CountBlank(DataRange) > 0 _
        And (Cells(f.Row, 4)) = "" _
        And (Cells(f.Row, 11)) <> "" _
        Then
                    MsgBox "Missing Project/Phase or Task on line " & f.Row - 9, , "Missing Data"
            Exit Sub
        End If
         
    Next f

'*****************ONCE THE DATA IS VALID, THE USER IS ALLOWED TO SUBMIT***********************************************


'Copy the Employee Name
    Range("EEName").Select
    Selection.Copy
    Sheets("Submissions").Select
    
'find the number of entries and set value as number of times to paste the employee name
    Range("K10").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -5).Select
    
    'how do i set the number in this cell as the number of times to paste the value?
    
    
    
'Find the first blank cell in column A
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    FirstBlankCell.Activate

'Paste the data in as many times as there are entries
    
    With Range(FirstBlankCell, "A" & lastrow&).Select
    Selection.PasteSpecial xlValues '***as many times as found in ActiveCell.Offset(0,-5).Select above
    
    End With

'Copy the Project name from the Time Sheet tab

    Sheets("Time Sheet").Select
    Range("Project").Select
    
    For Each cell In Range("Project")
    Sheets("Time Sheet").Select
    If Cells(d.Row, 4).Value <> "" Then
    cell.Copy
    
    Sheets("Submissions").Select

'On the Submissions tab: find the first blank cell in column B
    'Dim FirstBlankCell As Range
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 1)
    FirstBlankCell.Activate
    
'Paste in the copied data
    ActiveCell.PasteSpecial xlValues
    
    End If
    Next

'Copy the Phase name from the Time Sheet tab

    Sheets("Time Sheet").Select
    Range("Phase").Select
    
    For Each cell In Range("Phase")
    If Cells(1, 3).Value <> "" Then
    cell.Copy
    
    Sheets("Submissions").Select

'On the Submissions tab: go to the first cell in the next available line for column C
    'Dim FirstBlankCell As Range
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 2)
    FirstBlankCell.Activate
    
'Paste in the copied data
    ActiveCell.PasteSpecial xlValues
    
    End If
    Next
    
'Copy the Task name from the Time Sheet tab

    Sheets("Time Sheet").Select
    Range("Task").Select
    
    For Each cell In Range("Task")
    If Cells(0, 1).Value <> "" Then
    cell.Copy
    
    Sheets("Submissions").Select

'On the Submissions tab: find the first blank cell in column A
    'Dim FirstBlankCell As Range
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 3)
    FirstBlankCell.Activate
    
'Paste in the copied data
    ActiveCell.PasteSpecial xlValues
    
    End If
    Next
        
        
'Copy the Priority
    Sheets("Time Sheet").Select
    Range("Priority").Select
    
    For Each cell In Range("Priority")
    If cell.Value <> "" Then
    cell.Copy
    
    Sheets("Submissions").Select
    
'Find the first blank cell in column C
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 4)
    FirstBlankCell.Activate
    ActiveCell.PasteSpecial xlValues
    Sheets("Time Sheet").Select
    
    End If
    Next
    
'Copy the Short description
    Sheets("Time Sheet").Select
    Range("ShortDesc").Select
    
    For Each cell In Range("ShortDesc")
    If Cells.Offset(0, 1).Value <> "" Then
    cell.Copy
    
    Sheets("Submissions").Select
    
'Find the first blank cell in column F
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 5)
    FirstBlankCell.Activate
    ActiveCell.PasteSpecial xlValues
    Sheets("Time Sheet").Select
    
    End If
    Next
    
    
'Copy the Week Ending date
    Range("To").Select
    Selection.Copy
    Sheets("Submissions").Select
    
'Find the FIRST blank cell in column G
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 6)
    FirstBlankCell.Activate

'Find the LAST blank cell in column G, if there is data in column E for that row
    'Dim lastrow As Long
    lastrow = Worksheets("Submissions").Range("E2").End(xlDown).Row

'Paste the data into the range between first and last empty cells related to column E
    With Range(FirstBlankCell, "G" & lastrow&).Select
    Selection.PasteSpecial xlValues
    End With
        
'Copy the total hours per line
    Sheets("Time Sheet").Select
    Range("Hrs").Select
    
    For Each cell In Range("Hrs")
    If cell.Value <> "" Then
    cell.Copy
    
    Sheets("Submissions").Select


'Find the first blank cell in column H
    Set FirstBlankCell = Range("A" & Rows.Count).End(xlUp).Offset(1, 7)
    FirstBlankCell.Activate
    ActiveCell.PasteSpecial xlValues
    Sheets("Time Sheet").Select
    
    End If
    Next
    
    

    
'Copy formatting to new rows
    Selection.Offset(-13, 0).EntireRow.Copy
    Selection.EntireRow.PasteSpecial (xlFormats)
    Application.CutCopyMode = False
    
'delete all the data on the timesheet so new info can be entered
    Sheets("Time Sheet").Select
    Range("D10:G21, I10:S21").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("E4").Select

'ElseIf MsgResult = vbNo Then
'Exit Sub
'End If

Application.ScreenUpdating = True

End Sub

Would have been good to see the workbook but I understand your position.

Anyway, try this which relies on a few assumptions, eg data in time sheet starts on row 2.

NoEntries = Worksheets("Time Sheet").Range("B" & Rows.Count).End(xlUp).Row - 1

Worksheets("Submissions").Range("A" & Rows.Count).End(xlUp).Resize(NoEntries).Value = Range("EEName").Value

Pretty close, but the headers are on row 7/8 (merged, wrapped) and data entry is on rows 10 to 21. When I tried throwing these two lines in there I ended up with it posting the EE name 11 times when there were 4 rows of data.
I tried switching the reference but no go. I'm still too green.
I think I can post of copy of my workbook from home this eve...

You should just need to adjust the minus one, to take account of the other rows.

This is just another guess, I'm thinking that the merged cells may be a problem.

NoEntries = Worksheets("Time Sheet").Range("B" & Rows.Count).End(xlUp).Row - 7

Worksheets("Submissions").Range("A" & Rows.Count).End(xlUp).Resize(NoEntries).Value = Range("EEName").Value

It works! Woo hoo!
I just had to switch the row to -8 and switch out column B for the project column and poof! It is done.
Thank you Norie, I am so happy you helped me, even without seeing the original book.
I can't wait for the day when I'm not such a newbie I will understand how I can write this stuff so short & sweet like you did...

Glad you were able to fix my flawed code.

Phooey. Turns out it doesn't work...
The problem seems to be that I am referencing all of a column - ("B") in the example below - but I have 12 lines of timesheet entry space and then summary totals below it.
So when I use End(xlUp) for column "K" (the only column filled out for every line in use) I land in my summary totals section...
What I really need it to tell me is:
Within range K10:K21 (or "Priority" is the same named range) I want to know the number of lines used (always between 1 and 12).

Unfortunately just switching "K" to my named range "Priority" or the cell range "K10:K21" doesn't work.

I'm not sure how to modify the NoEntries line, in this case. It seems the 2nd line is working otherwise.