求助大神，同一工作簿内多张相同格式sheet工作表的合并

18994406660

网上找了各种代码尝试了两天两夜了，还是错误。帮忙看看修改一下，有偿！Sub 合并工作表333636()

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

        Sheets(1).Select

        Sheets.Add

        Sheets(1).Name = "汇总表"

        Dim i, j, k As Integer

            For k = 2 To Sheets.Count

                j = Sheets("汇总表").[a1048576].End(3).Row + 1

                Sheets(k).Select

                i = Sheets(k).[a1048576].End(3).Row

                Sheets(k).Rows("1" & ":" & i).Copy Sheets("汇总表").Cells(j, 1)
                 Next

            Sheets(1).Select

            Rows(1).Delete

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

End Sub

microyip

http://club.excelhome.net/thread-1310803-1-1.html 多表多工作簿汇总，参考变通一下

3190496160

楼主的代码思路不佳，

excel海

就用你的代码改的.................刚才合并单元格有点问题,已修改

1. <blockquote>Sub 合并工作表333636()

复制代码

answer6141

1. Option Explicit
   
2. 
   
3. Sub test()
   
4. Dim sht As Worksheet
   
5. Dim n, i, j, k, irow, icol As Long
   
6. For Each sht In Worksheets
   
7.     If sht.Name = "汇总表" Then n = 1
   
8. Next
   
9. If n = 0 Then
   
10.     Sheets.Add(before:=Sheets(1)).Name = "汇总表"
    
11. End If
    
12. i = 1
    
13. With Sheets("汇总表")
    
14.     .Cells.Delete
    
15.     For Each sht In Worksheets
    
16.         If sht.Name <> "汇总表" Then
    
17.             irow = sht.Cells(sht.Cells.Rows.Count, 4).End(xlUp).Row
    
18.             Debug.Print irow
    
19.             If Not Len(.Range("a1").Value) > 0 Then
    
20.                 sht.Range("a1:s" & irow).Copy .Range("a" & i)
    
21.                 i = i + irow
    
22.             Else
    
23.                 sht.Range("a4:s" & irow).Copy .Range("a" & i)
    
24.                 i = i + (irow - 3)
    
25.             End If
    
26.             
    
27.         End If
    
28.     Next
    
29. End With
    
30. End Sub
    

复制代码

answer6141

answer6141 发表于 2020-1-30 13:08

有帮助记得赏花

excel海

1. 为什么看不到.
   
2. Sub 合并工作表333636()
   
3.     Application.DisplayAlerts = False
   
4.     Application.ScreenUpdating = False
   
5.     Sheets(1).Select
   
6.     Sheets.Add
   
7.     Sheets(1).Name = "汇总表"
   
8.     Dim i, j, k As Integer
   
9.     For k = 2 To Sheets.Count
   
10.         j = Sheets("汇总表").[a1048576].End(3).Row
    
11.         Sheets(k).Select
    
12.         i = Sheets(k).[b1048576].End(3).Row
    
13.         Sheets(k).Rows("4" & ":" & i).Copy Sheets("汇总表").Cells(j, 1)
    
14.     Next
    
15.     Sheets(2).Range("a1:s3").Copy
    
16.     Sheets("汇总表").Cells(1, 1).EntireColumn.Insert Shift:=xlDown
    
17.     Application.DisplayAlerts = True
    
18.     Application.ScreenUpdating = True
    
19. End Sub

复制代码

18994406660

excel海 发表于 2020-1-30 13:16

还是不对，多处显示错误

excel海

18994406660 发表于 2020-1-30 14:58
还是不对，多处显示错误

错的地方截图看看

jzkwf

1. Sub 合并工作表()
   
2.     Dim i As Long, j As Long, j1 As Long
   
3.     Sheets.Add Sheets(1)
   
4.     Sheets(2).Range("a1").CurrentRegion.Copy Sheets(1).Range("a1")
   
5.     For i = 3 To Sheets.Count
   
6.         j = Cells(Rows.Count, 1).End(xlUp).Row + 1
   
7.         Sheets(i).Range("a1").CurrentRegion.Offset(3, 0).Copy Sheets(1).Range("a" & j)
   
8.     Next
   
9.     Sheets(1).Columns.AutoFit
   
10. End Sub
    

复制代码