Insert Data Validation in ever changing sheets using CountA and Offset in VBA

Question

I receive data that is similar in content, yet varies in the number and order of columns. I installed a drop down permanently in A6, copying it to each column in row 6,of the other columns, then select the appropriate header from the list. How can I amend my macro so it would either copy the DV from A6 or create identical headers where required? (determined by countA in Row 5)

This VBA solution places text where I want the dropdowns. Please tell me what I should use to replace the text "same dropdown as A6" so that it will automatically insert a dropdown with the header choices.

Private Sub CmdSubmit_Click()
    Dim i As Integer
   For i = 1 To 50


    ActiveSheet.Select
    Range("A5").Select

    If ActiveCell.Offset(0, 1).Value >= "1" Then
        ActiveCell.Offset(1, 0).Select
    Else
        Selection.End(xlToLeft).Offset(0, 1).Select
    End If
    ActiveCell.Offset(0, 1).Value = "same drop down as A6"
    ActiveCell.Offset(0, 2).Value = "same drop down as A6"
    ActiveCell.Offset(0, 3).Value = "same drop down as A6"
    ActiveCell.Offset(0, 4).Value = "Same drop down as A6"
   Next i

End Sub

---

This works, but it is not dynamic: Can we make it dynamic? Sub Thiscopypaste() Dim rngcopy As Range Dim i As Integer

Set rngcopy = ActiveSheet.Range("A6")

    rngcopy.Copy


Range("B5").Select
If ActiveCell.Value >= "1" Then
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

Range("C5").Select
If ActiveCell.Value >= "1" Then
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
 Range("D5").Select
If ActiveCell.Value >= "1" Then
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Range("E5").Select
If ActiveCell.Value >= "1" Then
ActiveCell.Offset(1, 0).Select
 ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Range("F5").Select
If ActiveCell.Value >= "1" Then
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If End Sub

Answer 1

If the dropdown you speak of is a data validation list then you need to perform the following:

    Private Sub CmdSubmit_Click()
        Dim i As Integer
        Dim rngCopy As Range

       For i = 1 To 50

        'ActiveSheet.Select
        Set rngCopy = ActiveSheet.Range("A6")

        rngCopy.Copy

        If rngCopy.Offset(-1, i).Value >= 1 Then
            'ActiveCell.Offset(1, 0).Select
            rngCopy.Offset(0, i).PasteSpecial xlPasteAll
        Else
            Set rngCopy = rngCopy.End(xlToLeft).Offset(0, i)
        End If
        'rngCopy.Offset(0, i).PasteSpecial xlPasteAll
        'rngCopy.Offset(0, 2).PasteSpecial xlPasteAll
        'rngCopy.Offset(0, 3).PasteSpecial xlPasteAll
        'rngCopy.Offset(0, 4).PasteSpecial xlPasteAll
       Next i

       Set rngCopy = Nothing

    End Sub