nối dữ liệu từ nhiều worksheet

[HuynhThiMinhPhung]

Nhờ mọi người xem giúp em bị lỗi ở đâu ạ,Mà em nối dữ liệu chỉ lấy line cuối cùng của tổng 7 sheet thôi ạ, Không lấy hết dữ liệu của từng sheet đượcạ

Sub NhieuworkSheets()
Dim x, lr_chinh, lr, fr As Integer
Dim ws As Worksheet

Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Car_data" Then
lr_chinh = Sheets("Car_data").Range("A" & 100).End(xlUp).Row
lr = ws.Range("A1000").End(xlUp).Row
ws.Range("A" & fr + 1 & ":M" & lr).Copy Sheets("Car_data").Range("A" & lr_chinh + 1)
End If
Next ws

Application.ScreenUpdating = True
End Sub

 

[BuiQuangThuan]

Nhờ mọi người xem giúp em bị lỗi ở đâu ạ,Mà em nối dữ liệu chỉ lấy line cuối cùng của tổng 7 sheet thôi ạ, Không lấy hết dữ liệu của từng sheet đượcạ

Sub NhieuworkSheets()
Dim x, lr_chinh, lr, fr As Integer
Dim ws As Worksheet

Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Car_data" Then
lr_chinh = Sheets("Car_data").Range("A" & 100).End(xlUp).Row
lr = ws.Range("A1000").End(xlUp).Row
ws.Range("A" & fr + 1 & ":M" & lr).Copy Sheets("Car_data").Range("A" & lr_chinh + 1)
End If
Next ws

Application.ScreenUpdating = True
End Sub

Thử điền mẫu vài dòng coi xem sao.

 

[CHAOQUAY]

Nhờ mọi người xem giúp em bị lỗi ở đâu ạ,Mà em nối dữ liệu chỉ lấy line cuối cùng của tổng 7 sheet thôi ạ, Không lấy hết dữ liệu của từng sheet đượcạ

Sub NhieuworkSheets()
Dim x, lr_chinh, lr, fr As Integer
Dim ws As Worksheet

Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Car_data" Then
lr_chinh = Sheets("Car_data").Range("A" & 100).End(xlUp).Row
lr = ws.Range("A1000").End(xlUp).Row
ws.Range("A" & fr + 1 & ":M" & lr).Copy Sheets("Car_data").Range("A" & lr_chinh + 1)
End If
Next ws

Application.ScreenUpdating = True
End Sub

Code này bạn đưa lên bị thiếu.
Trong file là như bên dưới

Option Explicit

Sub NhieuworkSheets()
Dim x, lr_chinh, lr, fr As Integer
Dim ws As Worksheet

Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "Car_data" Then
        lr_chinh = Sheets("Car_data").Range("A" & 100).End(xlUp).Row
        fr = ws.Range("A1").End(xlDown).Row
        lr = ws.Range("A1000").End(xlUp).Row
        ws.Range("A" & fr + 1 & ":M" & lr).Copy Sheets("Car_data").Range("A" & lr_chinh + 1)
    End If
Next ws

Application.ScreenUpdating = True
End Sub

Bỏ dòng fr = ... rồi chạy lại xem sao rồi tính tiếp

 

[HuynhThiMinhPhung]

Code này bạn đưa lên bị thiếu.
Trong file là như bên dưới

Option Explicit

Sub NhieuworkSheets()
Dim x, lr_chinh, lr, fr As Integer
Dim ws As Worksheet

Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "Car_data" Then
        lr_chinh = Sheets("Car_data").Range("A" & 100).End(xlUp).Row
        fr = ws.Range("A1").End(xlDown).Row
        lr = ws.Range("A1000").End(xlUp).Row
        ws.Range("A" & fr + 1 & ":M" & lr).Copy Sheets("Car_data").Range("A" & lr_chinh + 1)
    End If
Next ws

Application.ScreenUpdating = True
End Sub

Bỏ dòng fr = ... rồi chạy lại xem sao rồi tính tiếp

dạ em cám ơn nhiều ạ