Nhờ mọi người sửa code load file excel

[tu205489039]

Chào mọi người, mình có 1 file excel "conn" cần được load vào file "1". File "conn" được test về từ chương trình. khi mở file này lên nó báo lỗi, và mất hết định dạng. Nhờ mọi người chỉnh sửa giúp mình code trong modul 2 của file 1, để khi mình lấy dữ liệu của file "conn" thì nó bỏ qua thông báo lỗi của file "conn" và load vào file 1. Chứ hiện tại với code này nó chỉ load vào mà không có nội dung gì cả.
Mong mọi người giúp đỡ, mình cảm ơn!

 

[phulien1902]

Chào mọi người, mình có 1 file excel "conn" cần được load vào file "1". File "conn" được test về từ chương trình. khi mở file này lên nó báo lỗi, và mất hết định dạng. Nhờ mọi người chỉnh sửa giúp mình code trong modul 2 của file 1, để khi mình lấy dữ liệu của file "conn" thì nó bỏ qua thông báo lỗi của file "conn" và load vào file 1. Chứ hiện tại với code này nó chỉ load vào mà không có nội dung gì cả.
Mong mọi người giúp đỡ, mình cảm ơn!

Bạn thử:

Option Explicit
Sub ImportData()
    Dim Master As Worksheet, ws As Worksheet, sh As Worksheet, wk As Workbook
    Dim strFolderPath As String, strFileName As String, Str As String, ShName As String
    Dim Arr As Variant, v As Integer, Lr As Long
    Dim Tmp, Tmp1
Application.ScreenUpdating = False
On Error GoTo NoFile
Set Master = ActiveWorkbook.Sheets("Sheet1")
Arr = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xls*),*.xlsx*,*.xlsm*,*.xlsb*", MultiSelect:=True)
For v = LBound(Arr) To UBound(Arr)
    strFileName = Arr(v)
    Tmp = Split(strFileName, "\"): Tmp1 = Split(Tmp(UBound(Tmp)), ".")
    ShName = Tmp1(LBound(Tmp1))
    With Master
        If Not WsExit(ShName) Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = ShName
        End If
    End With
    Set ws = ActiveWorkbook.Sheets(ShName)
    Set wk = Workbooks.Open(strFileName)
    For Each sh In wk.Sheets
        If sh.Name = "conn" Then
            'Lr = sh.UsedRange.Rows.Count
            Lr = sh.Range("D65000").End(3).Row
            sh.Range("D11:D" & Lr).EntireRow.Copy ws.Range("A1")
        End If
    Next sh
    wk.Close
Next
MsgBox "Qua trinh lay du lieu hoan thanh   "
NoFile:
Exit Sub
Application.ScreenUpdating = True
End Sub

 

[tu205489039]

Mình cảm ơn bạn nhiều nhe