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

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.

This article has been dead for over six months. Start a new discussion instead.