Sub DuplicateRow()
Dim lRow As Long
Dim li As ListObject
Dim rngStart As Range
If TypeName(Selection) = "Range" Then
Set rngStart = Selection.Cells(1)
lRow = rngStart.Row
If lRow < Rows.Count Then
Application.ScreenUpdating = False
If rngStart.ListObject Is Nothing Then
Rows(lRow).Copy
Rows(lRow + 1).Insert Shift:=xlDown
Rows(lRow + 1).RowHeight = Rows(lRow).RowHeight
rngStart.Offset(1).Select
Else
Set li = rngStart.ListObject
If li.SourceType = xlSrcRange Then
If li.AutoFilter.FilterMode Then
li.AutoFilter.ShowAllData
End If
If li.DataBodyRange Is Nothing Then
li.ListRows.Add AlwaysInsert:=True
li.ListRows.Add AlwaysInsert:=True
Else
Application.DisplayAlerts = False
li.ListRows.Add(lRow - li.DataBodyRange.Row + 2).Range.FillDown
Rows(lRow + 1).RowHeight = Rows(lRow).RowHeight
rngStart.Offset(1).Select
Application.DisplayAlerts = True
End If
Else
MsgBox "这个表的SourceType = " & li.SourceType & ", 宏不支持." & vbNewLine & vbNewLine & _
Replace(Replace("0_NO SUPPORT_External data source (Microsoft SharePoint Foundation site)_(xlSrcExternal)|" & _
"1_SUPPORT__Range_(xlSrcRange)|2_NO SUPPORT_XML_(xlSrcXml)|3_NO SUPPORT_Query_(xlSrcQuery)|4_NO SUPPORT_PowerPivot Model_(xlSrcModel)", _
"|", vbNewLine), "_", vbTab), vbInformation
End If
End If
Application.ScreenUpdating = True
End If
End If
End Sub