实现多表合并

蓝盾设计

Sub 合并玻璃()
Dim wk As Worksheet
Set wk = Worksheets.Add
wk.Name = "玻璃"
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    For Each sh In Worksheets
        If sh.Name <> "玻璃" And sh.Range("G2") <> "" Then
            With sh
                .Range("G2").Copy Sheets("玻璃").Range("a" & 2 + m)
                .Range("I2").Copy Sheets("玻璃").Range("b" & 2 + m)
                .Range("G5:L14").Copy Sheets("玻璃").Range("c" & 2 + m)
                m = m + 10
                Columns("A:G").AutoFit              '自动调整
            End With
        End If
    Next
    Columns("E:E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
    MsgBox "当前工作簿下的全部工作表(玻璃)已经合并完毕！", vbInformation, "提示"
End Sub

蓝盾设计

有大师帮我看看我的多表合并不能合并工资表有公式的数据，请帮我优化修正一下代码。谢谢了

lpxkk

站位学习，老师们好

尼克松

liulang0808 发表于 2014-4-3 20:47
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Sheets(1).Range("a5:p999 ...

http://club.excelhome.net/thread-1393827-1-1.html
版主麻烦指导一下。

尼克松

chxw68 发表于 2014-4-3 21:15

http://club.excelhome.net/thread-1393827-1-1.html

老师请指教一下！谢谢！