Dim RangeSelected As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("E3:E42")) Is Nothing And _
Intersect(Target, Range("F3:F42")) Is Nothing And _
Intersect(Target, Range("G3:G42")) Is Nothing And _
Intersect(Target, Range("M17:M36")) Is Nothing Then
RangeSelected = Target.Address(0, 0)
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E3:E42")) Is Nothing And _
Intersect(Target, Range("F3:F42")) Is Nothing And _
Intersect(Target, Range("G3:G42")) Is Nothing And _
Intersect(Target, Range("M17:M36")) Is Nothing Then Exit Sub
Dim AddressCharacter As Long, EndAddressRow As Long
Dim SelectionRow As Long
Dim ActiveColumnLetter As String, LastMergedColumn As String
Dim EndDragColumnLetter As String, StartDragColumnLetter As String
Dim SelectionAddressArray As Variant
With Selection
If .Count = 1 And Application.CutCopyMode = False Then
Exit Sub
ElseIf .Count = 1 And Application.CutCopyMode = xlCopy Then
With Application
.EnableEvents = False
.Undo
Target.PasteSpecial Paste:=xlPasteValues
.CutCopyMode = False
.EnableEvents = True
Exit Sub
End With
End If
If .Count > 1 Then
With Application
If .CommandBars("Standard").Controls("&Undo").List(1) <> "Auto Fill" And _
.WorksheetFunction.CountA(Target) = 0 Then Exit Sub
If .CommandBars("Standard").Controls("&Undo").List(1) = "Paste" And _
.CutCopyMode = xlCopy Then
.EnableEvents = False
.Undo
If ActiveCell.MergeCells Then
SelectionAddressArray = Split(Selection.Address(0, 0), ":")
For AddressCharacter = 1 To Len(SelectionAddressArray(1))
If IsNumeric(Mid(SelectionAddressArray(1), AddressCharacter, 1)) Then _
EndAddressRow = EndAddressRow & Mid(SelectionAddressArray(1), _
AddressCharacter, 1)
Next
ActiveColumnLetter = Split(Cells(1, ActiveCell.Column).Address, "$")(1)
With Range(ActiveColumnLetter & Target.Row & ":" & _
ActiveColumnLetter & EndAddressRow)
If .MergeCells Then .UnMerge
End With
Range(RangeSelected).Copy
Range(ActiveColumnLetter & Target.Row & ":" & ActiveColumnLetter & _
EndAddressRow).PasteSpecial Paste:=xlPasteValues
.EnableEvents = True
LastMergedColumn = Left$(SelectionAddressArray(1), _
Len(SelectionAddressArray(1)) - Len(CStr(EndAddressRow)))
For MergeCellCounter = Target.Row To EndAddressRow
Range(ActiveColumnLetter & MergeCellCounter & ":" & _
LastMergedColumn & MergeCellCounter).Merge
Next
Exit Sub
Else
Target.PasteSpecial Paste:=xlPasteValues
.CutCopyMode = False
.EnableEvents = True
Exit Sub
End If
End If
SelectionAddressArray = Split(Selection.Address(0, 0), ":")
If ActiveCell.MergeCells And .CommandBars("Standard").Controls("&Undo").List(1) _
<> "Auto Fill" And .CommandBars("Standard").Controls("&Undo").List(1) _
<> "Paste" Then
EndAddressRow = ActiveCell.Row
If EndAddressRow - Target.Row = 1 Then Exit Sub
ElseIf ActiveCell.MergeCells And .CommandBars("Standard").Controls("&Undo").List(1) _
= "Auto Fill" Or ActiveCell.MergeCells And _
.CommandBars("Standard").Controls("&Undo").List(1) = "Paste" Then
.EnableEvents = False
.Undo
Range(SelectionAddressArray(0) & ":" & _
SelectionAddressArray(1)).FormulaR1C1 = Selection.Cells(1)
.EnableEvents = True
Exit Sub
End If
SelectionRow = Selection.Row
EndDragColumnLetter = Evaluate(Replace("=LEFT(""X"",MIN(FIND({0,1,2,3,4,5,6,7,8,9}" & _
",ASC(""X"")&1234567890))-1)", "X", SelectionAddressArray(1)))
StartDragColumnLetter = Split(Cells(1, ActiveCell.Column).Address, "$")(1)
.EnableEvents = False
.Undo
If SelectionRow = ActiveCell.Row Then
Range(SelectionAddressArray(0) & ":" & EndDragColumnLetter & _
ActiveCell.Row).AutoFill Destination:=Range(SelectionAddressArray(0) & _
":" & SelectionAddressArray(1)), Type:=xlFillValues
Else
Range(StartDragColumnLetter & ActiveCell.Row & ":" & EndDragColumnLetter & _
ActiveCell.Row).AutoFill Destination:=Range(SelectionAddressArray(1) & _
":" & SelectionAddressArray(0)), Type:=xlFillValues
End If
.EnableEvents = True
End With
End If
End With
End Sub