huynhphuong thcspt
Thành viên mới
- Tham gia
- 31/8/18
- Bài viết
- 45
- Được thích
- 10
Nhờ các bạn trên diễn đàn chỉnh lại (xem) dùm code sau. Mình không biết lỗi ở đâu mà cứ mỗi lần copy (dữ liệu) nhiều file vào 1 file thì 2 file đầu dữ liệu copy đúng, bất đầu từ file thứ 3 trở đi thì bị bỏ trống khoảng 4 dòng trở lên rồi mới copy dữ liệu vào. Chân thành cảm ơn.
CODE NHƯ SAU (sưu tầm trên điễn đàn):
Sub GopFileExcel()
'XOA DU LIEU TRUOC KHI TH
Sheets("DATA").Select
Range("A1:AZ1").EntireColumn.Delete
'KHAI BAO TH
Dim FilesToOpen
Dim x As Integer
Dim wb As Workbook
'LENH TH
On Error GoTo ErrHandler
Application.DisplayAlerts = False 'tat canh bao
Application.ScreenUpdating = False 'tat nhay man hinh
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xls), *.xls", MultiSelect:=True, Title:="Files to Merge")
If MsgBox("Ban co muon chac tong hop du lieu dia ban khong?", vbYesNo) = vbYes Then 'canh bao tong hop dia ban
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Set wb = Workbooks.Open(Filename:=FilesToOpen(x))
If x = 1 Then
wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
Else
lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
wb.Sheets(1).UsedRange.Offset(4).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)
End If
wb.Close False
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True 'tat nhay man hinh
Application.DisplayAlerts = True 'tat canh bao
Set wb = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End If 'ket thuc canh bao tong hop dia ban
End Sub
CODE NHƯ SAU (sưu tầm trên điễn đàn):
Sub GopFileExcel()
'XOA DU LIEU TRUOC KHI TH
Sheets("DATA").Select
Range("A1:AZ1").EntireColumn.Delete
'KHAI BAO TH
Dim FilesToOpen
Dim x As Integer
Dim wb As Workbook
'LENH TH
On Error GoTo ErrHandler
Application.DisplayAlerts = False 'tat canh bao
Application.ScreenUpdating = False 'tat nhay man hinh
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xls), *.xls", MultiSelect:=True, Title:="Files to Merge")
If MsgBox("Ban co muon chac tong hop du lieu dia ban khong?", vbYesNo) = vbYes Then 'canh bao tong hop dia ban
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Set wb = Workbooks.Open(Filename:=FilesToOpen(x))
If x = 1 Then
wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
Else
lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
wb.Sheets(1).UsedRange.Offset(4).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)
End If
wb.Close False
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True 'tat nhay man hinh
Application.DisplayAlerts = True 'tat canh bao
Set wb = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End If 'ket thuc canh bao tong hop dia ban
End Sub
