COPY DỮ LIỆU TỪ NHIỀU SHEET VÀO 1 SHEET BỊ THIẾU DỮ LIỆU

[thanhdo89]

Anh/chị nào xem giúp và giải thích giúp em đoạn code
"" Range("A13").Select
Selection.CurrentRegion.Select
Selection.Offset(12, 0).Resize(Selection.Rows.Count - 1).Select '-1
Selection.Copy Destination:=Sheets("2PL2").Range("P3260").End(xlUp)(2)""
Em muốn copy dữ liệu của tất cả các sheet tính từ sheet thứ 5 trở đi rùi rán vào ô P4 của sheet "2PL2"), nhưng em ko hiểu sao vba ở sheet đầu tiên nó copy của em thiếu mất 3 dòng, nó chỉ copy từ Dương Thị loan (dòng 16) mà 3 dòng đầu 13-15 nó ko copy cho em. Anh/chị nào xem giúp em với, em cám ơn ạ. Em Đô..

Option Explicit
Sub A92_PHULUC2()
Dim J As Integer
Dim Er As Long
On Error Resume Next
Sheets("2PL2").Range("A4:AG3258").Select
Selection.ClearContents
For J = 5 To Sheets.Count

Sheets(J).Activate
Er = Range("E" & Rows.Count).End(3).Row
If Er > 12 Then
With ActiveSheet.Range("A12:R" & Er)
.AutoFilter 11, Empty 'COT HO MAU DUOC CHON = 0 THI XOA
.AutoFilter 9, ">0"
.AutoFilter 5, "<>"""
.Offset(1).Resize(, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter

Range("A13").Select
Selection.CurrentRegion.Select
Selection.Offset(12, 0).Resize(Selection.Rows.Count - 1).Select '-1
Selection.Copy Destination:=Sheets("2PL2").Range("P3260").End(xlUp)(2)
' COPY DU LIEU BAT DAU TU DONG 13 CUA SHEET J RUI DAN VAO COT P4 O SHEET PL2
End With
End If
Next J

 

[Ba Tê]

View attachment 220596
Anh/chị nào xem giúp và giải thích giúp em đoạn code
"" Range("A13").Select
Selection.CurrentRegion.Select
Selection.Offset(12, 0).Resize(Selection.Rows.Count - 1).Select '-1
Selection.Copy Destination:=Sheets("2PL2").Range("P3260").End(xlUp)(2)""
Em muốn copy dữ liệu của tất cả các sheet tính từ sheet thứ 5 trở đi rùi rán vào ô P4 của sheet "2PL2"), nhưng em ko hiểu sao vba ở sheet đầu tiên nó copy của em thiếu mất 3 dòng, nó chỉ copy từ Dương Thị loan (dòng 16) mà 3 dòng đầu 13-15 nó ko copy cho em. Anh/chị nào xem giúp em với, em cám ơn ạ. Em Đô.View attachment 220599.

Option Explicit
Sub A92_PHULUC2()
Dim J As Integer
Dim Er As Long
On Error Resume Next
Sheets("2PL2").Range("A4:AG3258").Select
Selection.ClearContents
For J = 5 To Sheets.Count

Sheets(J).Activate
Er = Range("E" & Rows.Count).End(3).Row
If Er > 12 Then
With ActiveSheet.Range("A12:R" & Er)
.AutoFilter 11, Empty 'COT HO MAU DUOC CHON = 0 THI XOA
.AutoFilter 9, ">0"
.AutoFilter 5, "<>"""
.Offset(1).Resize(, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter

Range("A13").Select
Selection.CurrentRegion.Select
Selection.Offset(12, 0).Resize(Selection.Rows.Count - 1).Select '-1
Selection.Copy Destination:=Sheets("2PL2").Range("P3260").End(xlUp)(2)
' COPY DU LIEU BAT DAU TU DONG 13 CUA SHEET J RUI DAN VAO COT P4 O SHEET PL2
End With
End If
Next J
View attachment 220596

Bạn nên sửa lại tiêu đề bài viết: Không viết Hoa cả đoạn văn, cả câu.
Tôi không có khả năng giải thích Code của bạn.
Phần Copy các Sheet "DB*" về sheet "2PL2" bạn thử bằng cái này.
Chú ý không nên dùng On Error Resume Next vì nếu bị lỗi sẽ có kết quả "Tào xì lao"

Option Explicit

Sub A92_PHULUC2()
  Dim Ws As Worksheet
  Dim Er As Long
  Sheets("2PL2").Range("A4:AG3258").ClearContents
'===========================================Copy Dữ Liệu Từ Các Sheet DB*'
For Each Ws In ThisWorkbook.Worksheets
    If Left(Ws.Name, 2) = "DB" Then
        Er = Ws.Range("E" & Rows.Count).End(xlUp).Row
        If Er > 12 Then
            Ws.Range("A13:R" & Er).Copy Sheets("2PL2").Range("P" & Rows.Count).End(xlUp).Offset(1)
        End If
    End If
Next Ws
'======================================================'
    'Phần dưới này là của bạn.'

 

[thanhdo89]

Bạn nên sửa lại tiêu đề bài viết: Không viết Hoa cả đoạn văn, cả câu.
Tôi không có khả năng giải thích Code của bạn.
Phần Copy các Sheet "DB*" về sheet "2PL2" bạn thử bằng cái này.
Chú ý không nên dùng On Error Resume Next vì nếu bị lỗi sẽ có kết quả "Tào xì lao"

Option Explicit

Sub A92_PHULUC2()
  Dim Ws As Worksheet
  Dim Er As Long
  Sheets("2PL2").Range("A4:AG3258").ClearContents
'===========================================Copy Dữ Liệu Từ Các Sheet DB*'
For Each Ws In ThisWorkbook.Worksheets
    If Left(Ws.Name, 2) = "DB" Then
        Er = Ws.Range("E" & Rows.Count).End(xlUp).Row
        If Er > 12 Then
            Ws.Range("A13:R" & Er).Copy Sheets("2PL2").Range("P" & Rows.Count).End(xlUp).Offset(1)
        End If
    End If
Next Ws
'======================================================'
    'Phần dưới này là của bạn.'

Dạ e cám ơn anh ạ