Find value in range copy nth cell value to another sheet

Private Sub CommandButton1_Click()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim Rcount As Long
    Dim I As Long
    Dim NewSh As Worksheet
    Dim Num As Integer
    Dim Col As String
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    'Fill in the search Value
    MyArr = Array(ComboBox1.Value)
    'You can also use more values in the Array
    'myArr = Array("@", "www")
    Num = Month(Date)
    If Num = 1 Then Col = "B"
    If Num = 2 Then Col = "C"
    If Num = 3 Then Col = "D"
    If Num = 4 Then Col = "E"
    If Num = 5 Then Col = "F"
    If Num = 6 Then Col = "G"
    If Num = 7 Then Col = "H"
    If Num = 8 Then Col = "I"
    If Num = 9 Then Col = "J"
    If Num = 10 Then Col = "K"
    If Num = 11 Then Col = "L"
    If Num = 12 Then Col = "M"
    'Add new worksheet to your workbook to copy to
    'You can also use a existing sheet like this
    Set NewSh = Sheets("Sheet3")
    With Sheets("2012").Range("A1:Z100")
        Rcount = 0
        For I = LBound(MyArr) To UBound(MyArr)
            'If you use LookIn:=xlValues it will also work with a
            'formula cell that evaluates to "@"
            'Note : I use xlPart in this example and not xlWhole
            Set Rng = .Find(what:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1
                    NewSh.Range("A" & Rcount).Value = Rng.Value
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub