1、本方法要使用EXCEL VBA宏代码进行操作,代码如下:Option ExplicitSub 复制粘贴可见单元格() Dim rgSrc As Range Dim rgDes As Range Dim rg As Range, rgPt As Range Dim strSrcAdd() As String Dim lCnt As Long, i As Long, j As Long, x As Long, y As Long On Error GoTo ExitPoint Set rgSrc = Application.InputBox("请选择要复制的单元格区域", "提示", , , , , , 8) If rgSrc.Columns.Count > rgSrc.Parent.UsedRange.Columns.Count Then Set rgSrc = rgSrc.Parent.Range(rgSrc.Item(1, 1), rgSrc.Item(rgSrc.Rows.Count, rgSrc.Parent.UsedRange.Columns.Count)) End If If rgSrc.Rows.Count > rgSrc.Parent.UsedRange.Rows.Count Then Set rgSrc = rgSrc.Parent.Range(rgSrc.Item(1, 1), rgSrc.Item(rgSrc.Parent.UsedRange.Rows.Count, rgSrc.Columns.Count)) End If Set rgDes = Application.InputBox("请选择要粘贴的单元格位置", "提示", , , , , , 8) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set rgPt = rgDes.Cells(1, 1) ReDim strSrcAdd(0) For Each rg In rgSrc If Not (rg.Height = 0 Or rg.Width = 0) Then ReDim Preserve strSrcAdd(UBound(strSrcAdd) + 1) strSrcAdd(UBound(strSrcAdd)) = rg.Address End If Next rg lCnt = 0 For Each rg In rgSrc.Parent.Range((rgSrc.Rows(1).Address)) If rg.Width <> 0 Then lCnt = lCnt + 1 End If Next strSrcAdd(0) = lCnt i = 0 j = 0 x = 0 y = 0 For lCnt = 1 To UBound(strSrcAdd)lp: If ((lCnt - 1) \ strSrcAdd(0)) + i > x Then j = 0 End If x = ((lCnt - 1) \ strSrcAdd(0)) + i y = ((lCnt - 1) Mod strSrcAdd(0)) + j Set rg = rgPt.Offset(x, y) If rg.Width = 0 Then j = j + 1 GoTo lp ElseIf rg.Height = 0 Then i = i + 1 j = 0 GoTo lp Else rg.Value = rgSrc.Parent.Range(strSrcAdd(lCnt)) End If Next lCnt rgDes.Parent.ActivateExitPoint: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomaticEnd Sub下面将以一个示例的方式,演示如何使用以上代码。
2、图中标黄色的为要隐藏的单元格,隐藏前后效果如图所示。
3、在相应的工作表上点击右键,在弹出的窗口中选择“查看代码”
4、在打开的VBE界面中粘贴以上复制的代码。
5、在“查看宏”对话框中选择并运行名为“复制粘贴可见单元格”的宏。宏的使用方法,请另外百度。
6、先选择要复制的单元(也可以是整行或整列),然后选择要粘贴的单元格位置(可以多选,也可以只选一个,都是以选择区域的活动单元为开始粘贴位置)。
7、粘贴完成后对比效果如下图,宏只对可见的单元格进行了操作。