Insert Repeating Data into Column

[violette]

I need to insert data from cell 'B1' into a column that has 500 rows. how to make the data repeated on every row using macro VBA?i want to make it copy to multiple sheets?

below is my code:

Sub Copy()    Dim wbkFirst        As Workbook 
    Dim wbkSecond       As Workbook 
    Dim wksSheet        As Worksheet 
    Dim strFirstFile    As String 
    Dim strSecondFile   As String 
     
     
    strFirstFile = "C:\Documents and Settings\user\My Documents\FiST Mac\Bloomberg.xls" 
    strSecondFile = "C:\Documents and Settings\user\My Documents\FiST Mac\FiST_data_template.xls" 
     
     
    Set wbkFirst = Workbooks.Open(strFirstFile) 
    Set wbkSecond = Workbooks.Open(strSecondFile) 
    For Each wksSheet In wbkFirst.Worksheets 
        If wksSheet.Name = "Year" Then 
            With wksSheet 
                .Range("D5:AK" & .Range("A" & Rows.Count).End(xlUp).Row).Copy 
            End With 
             
            With wbkSecond.Worksheets("Yearly") 
                .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues 
                Cells(1, 2) = DatePart("yyyy", Now) 
                Set copyRange = Range("AJ5:AJ5000") 
                Range("B1").Copy copyRange 
                Set copyRange = Range("AK5:AK5000") 
                Range("D1").Copy copyRange 
            End With 
             
        ElseIf wksSheet.Name = "Q1" Then 
            With wksSheet 
                .Range("D5:AK" & .Range("A" & Rows.Count).End(xlUp).Row).Copy 
            End With 
             
            With wbkSecond.Worksheets("Q1") 
                .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues 
                Cells(1, 2) = DatePart("yyyy", Now) 
                Set copyRange = Range("AJ5:AJ5000") 
                Range("B1").Copy copyRange 
                Set copyRange = Range("AK5:AK5000") 
                Range("D1").Copy copyRange 
            End With 
             
             
        ElseIf wksSheet.Name = "Q2" Then 
            With wksSheet 
                .Range("D5:AK" & .Range("A" & Rows.Count).End(xlUp).Row).Copy 
            End With 
             
            With wbkSecond.Worksheets("Q2") 
                .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues 
                Cells(1, 2) = DatePart("yyyy", Now) 
                Set copyRange = Range("AJ5:AJ5000") 
                Range("B1").Copy copyRange 
                Set copyRange = Range("AK5:AK5000") 
                Range("D1").Copy copyRange 
            End With 
             
             
        ElseIf wksSheet.Name = "Q3" Then 
            With wksSheet 
                .Range("D5:AK" & .Range("A" & Rows.Count).End(xlUp).Row).Copy 
            End With 
             
            With wbkSecond.Worksheets("Q3") 
                .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues 
                Cells(1, 2) = DatePart("yyyy", Now) 
                Set copyRange = Range("AJ5:AJ5000") 
                Range("B1").Copy copyRange 
                Set copyRange = Range("AK5:AK5000") 
                Range("D1").Copy copyRange 
            End With 
             
             
        ElseIf wksSheet.Name = "Q4" Then 
            With wksSheet 
                .Range("D5:AK" & .Range("A" & Rows.Count).End(xlUp).Row).Copy 
            End With 
             
            With wbkSecond.Worksheets("Q4") 
                .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues 
                Cells(1, 2) = DatePart("yyyy", Now) 
                Set copyRange = Range("AJ5:AJ5000") 
                Range("B1").Copy copyRange 
                Set copyRange = Range("AK5:AK5000") 
                Range("D1").Copy copyRange 
            End With 
             
             
        Else 
            MsgBox "Error!", vbOKOnly, " FiST" 
             
        End If 
         
         
    Next wksSheet 
     
    Application.DisplayAlerts = False 
    Dim strFilename As String 
    Const strDir As String = "C:\Documents and Settings\user\My Documents\FiST Mac\" 
     
     
    strFilename = strDir & d & PrevMonth(Date) 
    wbkSecond.SaveAs strFilename, , , , False 
     
     
     
     'Dim Path As String
     'Path = ThisWorkbook.Path
     'wbkSecond.SaveAs Path & "/" & d & PrevMonth(Date), , , , False
     
     
     'wbkSecond.SaveAs d & PrevMonth(Date), , , , False
     'wbkSecond.SaveAs "C:\Documents and Settings\user\My Documents\FiST Mac\FISTdb.xls"
    wbkFirst.Close 
    MsgBox "FiST Database Updated", vbOKOnly, " FiST" 
     
     
    Application.DisplayAlerts = True 
     
     
End Sub 
Sub rptB() 
    Cells(1, 2) = DatePart("yyyy", Now) 
    Set copyRange = Range("AJ5:AJ500") 
    Range("B1").Copy copyRange 
End Sub 
 
 
Public Function PrevMonth(d) 
     'Requires the D in brackets, as used in the formulas below
     
     
    Dim M 
    M = Month(d) 
    Select Case M 
    Case 2 To 12 
        PrevMonth = Format(DateSerial(Year(d), M - 1, 1), "mmm") & Year(d) 
         ' Date Serial, Year, Month (M), Day of Month (1) - Needs name of function
    Case 1 
        PrevMonth = "Dec" & "_" & Year(d) - 1 
         ' Needs name of Function
    End Select 
End Function

[violette]

hi, i have found code that can copy the same data into a column. here's the code;

With wbkSecond.Worksheets("Yearly") 
    .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues 
    Cells(1, 2) = DatePart("yyyy", Now) 
    Set copyRange = Worksheets("Yearly").Range("AJ5:AJ5000") 
    Range("B1").Copy copyRange 
    Set copyRange = Worksheets("Yearly").Range("AK5:AK5000") 
    Range("D1").Copy copyRange 
End With

however, this code is for a fixed range from AJ5 to AK5000. what should i do if i want the data to be repeated more dynamic?for example, it will be repeated according to the number of data in column B.