Code không copy nhiều sheet thành 1 sheet được (1 người xem)

[chanh63]

Minh có đoạn code chạy trong excel nhưng chỉ copy được 5sheet thành 1 sheet. Mình muốn chạy code copy khoản 100sheet nhưng không được.Nhờ các bạn xem giúp cảm ơn

Sub Combine()
Dim J As Integer

On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"

' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")

' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("A1").Select
Selection.CurrentRegion.Select ' select all cells in this sheets

' select all lines except title
Selection.Offset(1, 1).Resize(Selection.Rows.Count - 1).Select

' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

 

[SA_DQ]

Sao bạn cứ 1 lần chạy code, 1 lần tao 'Combined làm chi

Bạn thử tạo 1 lần duy nhứt trang tính 'Combined' & chạy code sau:

Option Explicit
Sub GPE()
Dim Sh As Worksheet, cRng As Range

Sheets("Combined").Cells.Clear
For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Combined" Then
        Set cRng = Sh.[a1].CurrentRegion.Offset(1)
        cRng.Copy Destination:=Sheets("Combined").Range("A65536").End(xlUp).Offset(1)
    End If
Next Sh
End Sub