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 IfEnd Sub
