Vui lòng xem giúp Code copy Dữ liệu file đang đóng (1 người xem)

[KVP]

Chào các anh chị

Xin vui lòng xem giúp đoạn code làm báo cáo copy dữ liệu từ các File đang đóng này lỗi ở đâu?
Sub BAO CAO
Mình mở sổ chi tiết có tên theo mã DV trong sheets(DSDV) sau đó copy từng dòng tương ứng với dữ liệu cần lấy là BHXH, BHYT, BHTN vào 03 sheets tuong ứng BC_BHXH, BC_BHYT, BC_BHTN trong Workbook (BAOCAO) ứng với mã đơn vị trong từng Sheets

Không hiểu viết sai chỗ nào mà có lúc thì được có lúc thì không. Mong các anh chị xem giúp

Sub BAOCAO()
Dim i As Long, j As Long, k As Long, m As Long
Dim PathSCT As String, nameSCT As String, Quy As String, MAdv As String, Fadd As String
Dim rng As Range, rngf As Range
SpeedOn
For i = 4 To 4 
             'Workbooks("BAOCAO").Sheets("DSDV").[A65000].End(xlUp).Row'
    Workbooks("BAOCAO").Sheets("DSDV").Activate
    MAdv = Cells(i, 1)
    Quy = Cells(1, 2)
    'On Error Resume Next'
    ' Duong dan toi SCT don vi'
    nameSCT = Cells(i, 1) & ".xls"
    PathSCT = ThisWorkbook.Path & "\SCT\" & nameSCT
    'Mo  SCT  
        If Dir(PathSCT) <> "" And WBisOpen(nameSCT) = False And FileExit(nameSCT) = True Then
            Workbooks.Open (PathSCT)
        End If
    Workbooks("BAOCAO").Sheets("BC_BHXH").Activate
    Set rng = Range("C5:C" & [C65000].End(xlUp).Row)
    Set rngf = rng.Find(MAdv, Cells(5, 3), xlValues, xlWhole, xlByColumns, xlNext)
    If Not rngf Is Nothing Then
        Fadd = rngf.Address
        Do
            j = rngf.Row
            ' Dien thong tin BC cua khoi dong BHXH, BHYT, BHTN
            With Workbooks(nameSCT).Sheets("TH")
               For k = 10 To 25 ' Tim dong tuong ung BHXH, YT, TN trong SCt
                   If Trim(.Cells(k, 2)) = Quy Then
                    Select Case Trim(.Cells(k, 3))
                         Case "BHXH"
                            For m = 4 To 17
                                Cells(j, m) = .Cells(k, m)
                            Next m
              '.Range(.Cells(k, 4), .Cells(k, 17)).Copy: Cells(j, 4).PasteSpecial Paste:=xlValues '
                             'Application.CutCopyMode = xlCut
                         Case "BHYT"
                            For m = 4 To 17
                                Sheets("BC_BHYT").Cells(j, m) = .Cells(k, m)
                            Next m
        
                             '.Range(.Cells(k, 4), .Cells(k, 17)).Copy:'
                             'Sheets("BC_BHYT").Cells(j, 4).PasteSpecial Paste:=xlValues
                             'Application.CutCopyMode = xlCut'
                         Case "BHTN"
                            For m = 4 To 17
                                Sheets("BC_BHTN").Cells(j, m) = .Cells(k, m)
                            Next m
                       
                     End Select
                   End If
                   
                Next k
            End With
            Set rngf = rng.FindNext(rngf)
        Loop While Not rngf Is Nothing And Fadd <> rngf.Address
     End If
    
    Workbooks(nameSCT).Close True
Next i
Application.Calculation = xlCalculationAutomatic
Set rng = Nothing
Set rngf = Nothing
SpeedOff
End Sub

Trân thành cám ơn.

 

[ThuNghi]

Chào các anh chị

Xin vui lòng xem giúp đoạn code làm báo cáo copy dữ liệu từ các File đang đóng này lỗi ở đâu?
Sub BAO CAO
Mình mở sổ chi tiết có tên theo mã DV trong sheets(DSDV) sau đó copy từng dòng tương ứng với dữ liệu cần lấy là BHXH, BHYT, BHTN vào 03 sheets tuong ứng BC_BHXH, BC_BHYT, BC_BHTN trong Workbook (BAOCAO) ứng với mã đơn vị trong từng Sheets

Bạn kiểm tra câu này xem.

If Dir(PathSCT) <> "" And WBisOpen(nameSCT) = False And FileExit(nameSCT) = True Then

Mà hình như code này cũng phải mở file ra, lấy dữ liệu sau đó đóng lại.
Tôi thì cứ mở file (nếu đang đóng) và copy Sh cần truy xuất vào Sh Tmp
Đóng file đó lại.
Truy xuất
Sao đó xóa tmp
Với lại xem lại các Sub Speedon(...)....
Tôi cũng chưa hiểu lắm. Nếu có thể mình viết code lại.

 

[KVP]

Cám ơn anh.

Em tìm mấy ngày mới thấy cái lỗi ngớ ngẩn Thiếu UCASE$ của cells chữa text "BHXH" , "BHYT", "BHTN"
Speedon
...
SpeedOff
Là code tăng tốc độ thủ tục của anh Duyệt

Hiện em đã hoàn tất được file của mình.