VBA Copy vùng dữ liệu ở nhiều sheet về 1 sheet TONGHOP

[minhduc_kt91]

Mình cần giúp đỡ VBA copy dữ liệu ở các sheet 1,2,3,... format giống nhau, copy vùng D6:E11 paste về sheet TONGHOP.
Cảm ơn mọi người giúp đỡ

 

[BuiQuangThuan]

Sao không dùng 1 sheet xong đẩy dữ liệu vô bạn.Trong file có sheet Tong hop nào đâu nhỉ

 

[Thóc Sama]

Mình cần giúp đỡ VBA copy dữ liệu ở các sheet 1,2,3,... format giống nhau, copy vùng D6:E11 paste về sheet TONGHOP.
Cảm ơn mọi người giúp đỡ

Bạn thử code sau xem có giúp được gì không?

Option Explicit
Sub Tong_Hop()
    Dim Ws As Worksheet, lr&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each Ws In Worksheets
        If Ws.Name = "Tong Hop" Then Ws.Delete
    Next Ws
    Worksheets.Add after:=Sheets(3)
    ActiveSheet.Name = "Tong Hop"
    With Sheets("Tong Hop")
        .Columns("B:B").ColumnWidth = 19.5
        .Columns("C:C").ColumnWidth = 60
        .Rows("1:100000").RowHeight = 18.75
        ActiveWindow.DisplayGridlines = False
    End With
    For Each Ws In Worksheets
        If IsNumeric(Ws.Name) Then
            lr = Sheets("Tong Hop").Range("B" & Rows.Count).End(xlUp).Row + 3
            Ws.Range("D6:E11").Copy Sheets("Tong Hop").Range("B" & lr)
        End If
    Next Ws
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[minhduc_kt91]

Bạn thử code sau xem có giúp được gì không?

Option Explicit
Sub Tong_Hop()
    Dim Ws As Worksheet, lr&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each Ws In Worksheets
        If Ws.Name = "Tong Hop" Then Ws.Delete
    Next Ws
    Worksheets.Add after:=Sheets(3)
    ActiveSheet.Name = "Tong Hop"
    With Sheets("Tong Hop")
        .Columns("B:B").ColumnWidth = 19.5
        .Columns("C:C").ColumnWidth = 60
        .Rows("1:100000").RowHeight = 18.75
        ActiveWindow.DisplayGridlines = False
    End With
    For Each Ws In Worksheets
        If IsNumeric(Ws.Name) Then
            lr = Sheets("Tong Hop").Range("B" & Rows.Count).End(xlUp).Row + 3
            Ws.Range("D6:E11").Copy Sheets("Tong Hop").Range("B" & lr)
        End If
    Next Ws
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

được rồi bác ạ, cảm ơn bác, sáng e cũng cop nhặt ra chỉnh chỉnh được VBA nhưng nó chạy ko mượt như của bác

Bài đã được tự động gộp: 17/3/23

Bạn thử code sau xem có giúp được gì không?

Option Explicit
Sub Tong_Hop()
    Dim Ws As Worksheet, lr&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each Ws In Worksheets
        If Ws.Name = "Tong Hop" Then Ws.Delete
    Next Ws
    Worksheets.Add after:=Sheets(3)
    ActiveSheet.Name = "Tong Hop"
    With Sheets("Tong Hop")
        .Columns("B:B").ColumnWidth = 19.5
        .Columns("C:C").ColumnWidth = 60
        .Rows("1:100000").RowHeight = 18.75
        ActiveWindow.DisplayGridlines = False
    End With
    For Each Ws In Worksheets
        If IsNumeric(Ws.Name) Then
            lr = Sheets("Tong Hop").Range("B" & Rows.Count).End(xlUp).Row + 3
            Ws.Range("D6:E11").Copy Sheets("Tong Hop").Range("B" & lr)
        End If
    Next Ws
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

ah file nguồn nó cũng không chuẩn lắm định dạng , nên chỗ seting chiều dài rộng cao cho cột, dòng em đã chỉnh của bác thành AutoFit thì đẹp hơn. Tks bác nha