Saya mencoba untuk menyalin data dari 7 lembar kerja yang berbeda (Dalam buku kerja yang sama) ke dalam satu lembar kerja yang disebut Gabungkan [duplikat]

Question

Saya mencoba menyalin data dari 7 lembar kerja yang berbeda (Dalam buku kerja yang sama) ke dalam satu lembar kerja yang disebut Gabungkan. Saya juga membutuhkan sheet yang disebut 'Ringkasan' untuk tidak disalin. dan kemudian setelah 7 lembar kerja disalin, mereka perlu dihapus.

Ini yang saya dapatkan sejauh ini tetapi hanya menyalin lembar kerja ACT

Sub Combine()

    Dim s As Worksheet, wb As Workbook, wsDest As Worksheet, rngCopy As Range

    Set wb = ActiveWorkbook  ' always specify a workbook

    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Sheets("ACT").Delete 'These sheets don't need to be kept or consolidated
    wb.Sheets("VIC").Delete
    wb.Sheets("NSW").Delete
    wb.Sheets("QLD").Delete
    wb.Sheets("NT").Delete
    wb.Sheets("SA").Delete
    wb.Sheets("WA").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'get a direct reference to the newly-added sheet
    Set wsDest = wb.Worksheets.Add(before:=wb.Worksheets(1))
    wsDest.Name = "Combine"

    wb.Sheets(2).Range("A1").EntireRow.Copy Destination:=wsDest.Range("A1")

    For Each s In ActiveWorkbook.Sheets
        If s.Name <> "Summary" Then    ' remove hard-coded name
            Set rngCopy = s.Range("A1").CurrentRegion
            'check how many rows before copying
            If rngCopy.Rows.Count > 1 Then
                'no need for select/activate
                rngCopy.Offset(1, 0).Resize(rngCopy.Rows.Count - 1).Copy _
                   wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            End If
        End If
    Next s
End Sub

Answer 1

coba kode di bawah ini, edisi ditandai.

Sub Combine()
Dim rngCopy As Range                        '<< edited visual
Dim wb As Workbook                          '<< edited visual
Dim s As Worksheet, wsDest As Worksheet     '<< edited visual

Application.DisplayAlerts = False   '<< edited
Application.EnableEvents = False    '<< edited
Application.ScreenUpdating = False  '<< edited

Set wb = ThisWorkbook  '<< edited
'get a direct reference to the newly-added sheet
Set wsDest = wb.Worksheets.Add(before:=wb.Worksheets(1))    '<< edited visual
wsDest.Name = "Combine"                                     '<< edited visual
wb.Worksheets(2).Rows(1).EntireRow.Copy Destination:=wsDest.Range("A1")         '<< edited

For Each s In wb.Worksheets     '<< edited
    If s.Name = "ACT" Or s.Name = "VIC" Or s.Name = "NSW" Or _
        s.Name = "QLD" Or s.Name = "NT" Or s.Name = "SA" Or s.Name = "WA" Then  '<< edited
        s.Delete                                                                '<< edited
    ElseIf s.Name <> "Summary" Then    '<< remove hard-coded name
        Set rngCopy = s.Range("A1").CurrentRegion
        'check how many rows before copying
        If rngCopy.Rows.Count > 1 Then
            'no need for select/activate
            rngCopy.Offset(1, 0).Resize(rngCopy.Rows.Count - 1).Copy _
            wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
    End If
Next s

Application.DisplayAlerts = True    '<< edited
Application.EnableEvents = True     '<< edited
Application.ScreenUpdating = True   '<< edited
End Sub