教你，如何复制单元格内容到所有工作表相同位置，可以炫耀了

No.1

有这样一种情况，如果一个Excel工作薄中有很多工作表，而且工作表格式相同，假如想把某些单元格内容同时复制到所有表中，有没有快捷办法？

答案是：有。

本节介绍一个Sheets对象方法，可实现如上操作。

工作当中有时会遇到将某个表格分别保存为不同的表，而且这些表的某些内容相同，如此，我们将需要复制这些相同的单元格。

手动操作显然不可取，几百几千张表同样的效果，那么就是天量的工作。

其实，一个方法可以在几秒钟之内完成。

这不是一个故事，曾经在工作当中遇到过，一次办公室需要将所有人员进行分别制作一张表，当然内容基本相同，仅仅姓名一栏不同，怎么办呢，对于小白来说，真是一头大汗。

我看了一下，对文员说，我来吧！

大概不到一分钟，文员还在疑惑当中，我已经完成几十张表的制作。

她似乎没有意识到时间的流动，顷刻间已经解决了一个大问题。

看着她吃惊的样子，我已经留给她一个背影。

有些时候真是对办公人员不求上进的想法感到无奈，这些是办公当中必不可少的一些基本技能。然而，没有意识到可以用更加便捷的方法来提高工作效率。

扯远了，上图为本示例的一个完整图。

可以实现把表格复制到所有工作表当中的相同位置。

用到了一个方法FillAcrossSheets，它是Sheets对象下的一个方法。

其中，有两个参数FillAcrossSheets （Range,Type）

Range是一个单元格对象，也就是要复制的单元格。

Type是复制的方式，有3种选项。具体可参考上图有解释。

No.2

按钮代码

Private Sub CommandButton2_Click() Dim cell As Range, Ki As Long, cellStr As String Ki = VBA.Val(Me.ComboBox1.Value) cellStr = 'B3:H11' ClearCells Me, getSheet, cellStr Set cell = ActiveSheet.Range('B3:H11') Sheets(getSheet).FillAcrossSheets cell, KiEnd Sub

取所有工作表名函数

Private Function getSheet() '获取工作表名    Dim ws As Worksheet, iArr, i As Integer    ReDim iArr(0)    For Each ws In ThisWorkbook.Worksheets            ReDim Preserve iArr(i)            iArr(i) = ws.Name            i = i + 1    Next ws    getSheet = iArrEnd Function

清除工作表内容过程

Private Sub ClearCells(meName, SheetArr, cellStr) '清除数据 Dim sName As Variant For Each sName In SheetArr If sName <> meName.Name Then ThisWorkbook.Worksheets(sName).Range(cellStr).Clear End If Next sNameEnd Sub

上面三段为完整代码，新建一个工作薄复制到VBE里，可调试使用。

修改相关Range地址，可实现任意复制。

这样，假如一个工作薄里有100个工作表，只需要单击一下鼠标，很快就复制完成了。

还不赶快收藏备用！