Code copy dữ liệu từ nhiều file có format giống nhau (1 người xem)

[Dong Le]

Dear các bác, hiện tại mình có đoạn code copy dữ liệu từ nhiều file vào 1 file cùng format, tuy nhiên, khi chạy file thì nếu file được copy có dưới 10 dòng dữ liệu thì không sao, nhưng nếu hơn 10 dòng dữ liệu thì nó báo lỗi(file đính kèm). chon yes thì nó vẫn copy nhưng vì copy nhiều file mà cứ chọn thế thì mất công quá, các bác kiểm tra và fix lỗi này giúp mình với.Private Sub CommandButton1_Click()
Application.ScreenUpdating = 0
'On Error Resume Next
Set Data = Sheets("Data")
Set TH = Sheets("Sales Report (TT)")
X = Application.GetOpenFilename(filefilter:="*.xls,*.xls, *.xlsx,*.xlsx", MultiSelect:=True)
If TypeName(X) = "Boolean" Then
MsgBox "No Files were selected"
Application.ScreenUpdating = 1
End
End If
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
dk = ActiveWorkbook.Sheets("Sales Report (TT)").[c65536].End(3).Value
'MsgBox dk
Range([a25], [A65536].End(3).Offset(, 15)).AutoFilter 3, dk
Rows("27:3000").Delete
AutoFilterMode = 0
With ActiveWorkbook
With .Sheets("Sales Report (TT)")
.Range(.[a27], .[A65536].End(3).Offset(, 15)).Copy
[A65536].End(3).Offset(1).PasteSpecial 3
End With
.Close False
End With
Next
For c = 7 To 10
Cells(26, c).Value = Application.Sum(Range(Cells(27, c), Cells(2000, c)))
Next
Range([a26], [A65536].End(3).Offset(, 15)).Sort key1:=[c25], Header:=1
MsgBox " Da Cap Nhat Xong " & UBound(X) & " Files "
Application.ScreenUpdating = 1
End Sub

 

[Dong Le]

Dear các bác, hiện tại mình có đoạn code copy dữ liệu từ nhiều file vào 1 file cùng format, tuy nhiên, khi chạy file thì nếu file được copy có dưới 10 dòng dữ liệu thì không sao, nhưng nếu hơn 10 dòng dữ liệu thì nó báo lỗi(file đính kèm). chon yes thì nó vẫn copy nhưng vì copy nhiều file mà cứ chọn thế thì mất công quá, các bác kiểm tra và fix lỗi này giúp mình với.Private Sub CommandButton1_Click()
Application.ScreenUpdating = 0
'On Error Resume Next
Set Data = Sheets("Data")
Set TH = Sheets("Sales Report (TT)")
X = Application.GetOpenFilename(filefilter:="*.xls,*.xls, *.xlsx,*.xlsx", MultiSelect:=True)
If TypeName(X) = "Boolean" Then
MsgBox "No Files were selected"
Application.ScreenUpdating = 1
End
End If
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
dk = ActiveWorkbook.Sheets("Sales Report (TT)").[c65536].End(3).Value
'MsgBox dk
Range([a25], [A65536].End(3).Offset(, 15)).AutoFilter 3, dk
Rows("27:3000").Delete
AutoFilterMode = 0
With ActiveWorkbook
With .Sheets("Sales Report (TT)")
.Range(.[a27], .[A65536].End(3).Offset(, 15)).Copy
[A65536].End(3).Offset(1).PasteSpecial 3
End With
.Close False
End With
Next
For c = 7 To 10
Cells(26, c).Value = Application.Sum(Range(Cells(27, c), Cells(2000, c)))
Next
Range([a26], [A65536].End(3).Offset(, 15)).Sort key1:=[c25], Header:=1
MsgBox " Da Cap Nhat Xong " & UBound(X) & " Files "
Application.ScreenUpdating = 1
End Sub

Nhờ các cao thủ GPE giúp mình lỗi này với.

 

[Quang_Hải]

Dear các bác, hiện tại mình có đoạn code copy dữ liệu từ nhiều file vào 1 file cùng format, tuy nhiên, khi chạy file thì nếu file được copy có dưới 10 dòng dữ liệu thì không sao, nhưng nếu hơn 10 dòng dữ liệu thì nó báo lỗi(file đính kèm). chon yes thì nó vẫn copy nhưng vì copy nhiều file mà cứ chọn thế thì mất công quá, các bác kiểm tra và fix lỗi này giúp mình với.Private Sub CommandButton1_Click()
Application.ScreenUpdating = 0
'On Error Resume Next
Set Data = Sheets("Data")
Set TH = Sheets("Sales Report (TT)")
X = Application.GetOpenFilename(filefilter:="*.xls,*.xls, *.xlsx,*.xlsx", MultiSelect:=True)
If TypeName(X) = "Boolean" Then
MsgBox "No Files were selected"
Application.ScreenUpdating = 1
End
End If
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
dk = ActiveWorkbook.Sheets("Sales Report (TT)").[c65536].End(3).Value
'MsgBox dk
Range([a25], [A65536].End(3).Offset(, 15)).AutoFilter 3, dk
Rows("27:3000").Delete
AutoFilterMode = 0
With ActiveWorkbook
With .Sheets("Sales Report (TT)")
.Range(.[a27], .[A65536].End(3).Offset(, 15)).Copy
[A65536].End(3).Offset(1).PasteSpecial 3
Application.CutCopyMode = False
End With
.Close False
End With
Next
For c = 7 To 10
Cells(26, c).Value = Application.Sum(Range(Cells(27, c), Cells(2000, c)))
Next
Range([a26], [A65536].End(3).Offset(, 15)).Sort key1:=[c25], Header:=1
MsgBox " Da Cap Nhat Xong " & UBound(X) & " Files "
Application.ScreenUpdating = 1
End Sub

Thêm dòng màu đỏ vào sẽ hết thông báo

 

[Dong Le]

Thêm dòng màu đỏ vào sẽ hết thông báo

Cám ơn anh Hải, thêm lệnh này vào thì đã fix được lỗi.

 

[phongkiemtinh]

Bạn Đồng lê ơi, cho minh xin file được ko?mình đang cần tổng hợp như vậy. Mình xem code với