Không copy dữ liệu từ các file lẻ sang file có tên master

bebeen · 7/12/14

Chào các A/C! Em đã thiết lập code để copy dữ liệu ở các file lẻ (file đính kèm). Nhưng không hiểu sao code có vấn đề gì mà không thể copy được? A/C chỉ thêm cho em nhé!

Kiều Mạnh · 7/12/14

bebeen đã viết:
Chào các A/C! Em đã thiết lập code để copy dữ liệu ở các file lẻ (file đính kèm). Nhưng không hiểu sao code có vấn đề gì mà không thể copy được? A/C chỉ thêm cho em nhé!

Tải về coi có thấy code đâu chứ ??????????? có lộn file ko vậy

NH_DK · 7/12/14

@kieu manh ơi, code ở trong file master mà?

Kiều Mạnh · 7/12/14

NH_DK đã viết:
@kieu manh ơi, code ở trong file master mà?

ngại ghê có mô mà có chứ...?????????Hỏng lẻ máy mình có ma tải về mở lên nó biến luôn
sao hai nick khác nhau mà hai hinh lại giống nhau ta ... Phải chăng là ....
khà khà khà

Quang_Hải · 7/12/14

NH_DK đã viết:
@kieu manh ơi, code ở trong file master mà?

Xin thề là mình cũng chẳng đọc được dòng code nào...

bebeen · 8/12/14

quanghai1969 đã viết:
Xin thề là mình cũng chẳng đọc được dòng code nào...

Anh xem lai nhé! Em mở vẫn có mà. Nó ở module mdLapBC.

Mã:

Option Explicit


Sub CapNhat_data()
    
    Dim master As Worksheet, sh As Worksheet
    Dim wk As Workbook
    Dim strFolderPath As String
    Dim selectedfiles As Variant
    Dim iFileNum As Integer, iLastRowReport As Integer, iNumberOfRowsToPaste As Integer
    Dim strFilename As String
    Dim rDate As Range, rDesc As Range, rUnit As Range, rQuantity As Range, rPrice As Range, rAmount As Range, rRemark As Range
    Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
    
    getSpeed (True)
    Set master = ActiveWorkbook.Sheets("Data")
    strFolderPath = ActiveWorkbook.Path
    ChDrive strFolderPath
    ChDir strFolderPath
    selectedfiles = Application.GetOpenFilename( _
                    FileFilter:="Excel File(*.xls*),*.xlsx*", MultiSelect:=True)
    
    On Error GoTo NoFileselected
    
    For iFileNum = LBound(selectedfiles) To UBound(selectedfiles)
        strFilename = selectedfiles(iFileNum)
        
        Set wk = Workbooks.Open(strFilename)
                
        For Each sh In wk.Sheets
            
            If sh.Name Like "*-REPORT" Then
                With sh
                    iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row
                    iNumberOfRowsToPaste = iLastRowReport - 6 + 1
                    
                    rDate = .Range("A6:A" & iLastRowReport)
                    rDesc = .Range("B6:B" & iLastRowReport)
                    rUnit = .Range("C6:C" & iLastRowReport)
                    rQuantity = .Range("D6:D" & iLastRowReport)
                    rPrice = .Range("E6:E" & iLastRowReport)
                    rAmount = .Range("F6:F" & iLastRowReport)
                    rRemark = .Range("G6:G" & iLastRowReport)
                    
                    With master
                        iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row
                        iRowStartToPaste = iCurrentLastRow + 1
                        .Range("A" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rDate.Value2
                        .Range("B" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rDesc.Value2
                        .Range("C" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rUnit.Value2
                        .Range("D" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rQuantity.Value2
                        .Range("E" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rPrice.Value2
                        .Range("F" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rAmount.Value2
                        .Range("G" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rRemark.Value2
                        
                    End With
                End With
            End If
        Next sh
        wk.Close
    Next
    getSpeed (False)
NoFileselected:
    Exit Sub
    
End Sub

Quang_Hải · 8/12/14

bebeen đã viết:

Anh xem lai nhé! Em mở vẫn có mà. Nó ở module mdLapBC.

Mã:

Option Explicit


Sub CapNhat_data()
   
    Dim master As Worksheet, sh As Worksheet
    Dim wk As Workbook
    Dim strFolderPath As String
    Dim selectedfiles As Variant
    Dim iFileNum As Integer, iLastRowReport As Integer, iNumberOfRowsToPaste As Integer
    Dim strFilename As String
    Dim rDate As Range, rDesc As Range, rUnit As Range, rQuantity As Range, rPrice As Range, rAmount As Range, rRemark As Range
    Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
   
    getSpeed (True)
    Set master = ActiveWorkbook.Sheets("Data")
    strFolderPath = ActiveWorkbook.Path
    ChDrive strFolderPath
    ChDir strFolderPath
    selectedfiles = Application.GetOpenFilename( _
                    FileFilter:="Excel File(*.xls*),*.xlsx*", MultiSelect:=True)
   
    On Error GoTo NoFileselected
   
    For iFileNum = LBound(selectedfiles) To UBound(selectedfiles)
        strFilename = selectedfiles(iFileNum)
       
        Set wk = Workbooks.Open(strFilename)
               
        For Each sh In wk.Sheets
           
            If sh.Name Like "*-REPORT" Then
                With sh
                    iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row
                    iNumberOfRowsToPaste = iLastRowReport - 6 + 1
                   
                    rDate = .Range("A6:A" & iLastRowReport)
                    rDesc = .Range("B6:B" & iLastRowReport)
                    rUnit = .Range("C6:C" & iLastRowReport)
                    rQuantity = .Range("D6:D" & iLastRowReport)
                    rPrice = .Range("E6:E" & iLastRowReport)
                    rAmount = .Range("F6:F" & iLastRowReport)
                    rRemark = .Range("G6:G" & iLastRowReport)
                   
                    With master
                        iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row
                        iRowStartToPaste = iCurrentLastRow + 1
                        .Range("A" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rDate.Value2
                        .Range("B" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rDesc.Value2
                        .Range("C" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rUnit.Value2
                        .Range("D" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rQuantity.Value2
                        .Range("E" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rPrice.Value2
                        .Range("F" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rAmount.Value2
                        .Range("G" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rRemark.Value2
                       
                    End With
                End With
            End If
        Next sh
        wk.Close
    Next
    getSpeed (False)
NoFileselected:
    Exit Sub
   
End Sub

Thử code này coi đúng ý không

PHP:

Sub Tonghop()
Dim X&, I&, Sh As Worksheet, CurSh As Worksheet, Data()
Set CurSh = Sheets("Data")
X = Application.GetOpenFilename("Excel Files,*.xls?", , , , True)
If Not IsArray(X) Then Exit Sub
For I = 1 To UBound(X)
   With Workbooks.Open(X(I), 0)
      For Each Sh In .Worksheets
         If Sh.Name Like "*REPORT" Then
            Data = Sh.Range("A6", Sh.[A65536].End(3)).Resize(, 7).Value
            CurSh.[A65536].End(3)(2).Resize(UBound(Data), 7) = Data
         End If
      Next
      .Close False
   End With
Next
End Sub

bebeen · 8/12/14

Cám ơn anh @quanghai1969 nhiều! Em không nghĩ nó lại ngắn đến vậy. Code kia em tìm được chỗ sai rùi. Chỗ sai đó không nên có. Vậy mà....!

Quang_Hải · 8/12/14

bebeen đã viết:
Cám ơn anh @quanghai1969 nhiều! Em không nghĩ nó lại ngắn đến vậy. Code kia em tìm được chỗ sai rùi. Chỗ sai đó không nên có. Vậy mà....!

Lẽ ra phải nghĩ là nó ngắn trước. Sau khi viết ngắn mà nó không chịu chạy thì mới thêm râu ria vô cho nó chạy. Theo kinh nghiệm thì sau mỗi cặp lệnh thì thử code 1 cái coi nó có ra đúng như mình mong đợi hay không rồi mới viết tiếp. Chứ viết cả rừng rồi mới test code thì biết đường nào mà tìm.
Dù gì thì nhìn đoạn code gốc cũng thán phục sự kiên nhẫn thiệt đó. Dù không gọn nhưng được cái hoành tráng lệ...

Đình Phán · 24/2/15

quanghai1969 đã viết:
Lẽ ra phải nghĩ là nó ngắn trước. Sau khi viết ngắn mà nó không chịu chạy thì mới thêm râu ria vô cho nó chạy. Theo kinh nghiệm thì sau mỗi cặp lệnh thì thử code 1 cái coi nó có ra đúng như mình mong đợi hay không rồi mới viết tiếp. Chứ viết cả rừng rồi mới test code thì biết đường nào mà tìm.
Dù gì thì nhìn đoạn code gốc cũng thán phục sự kiên nhẫn thiệt đó. Dù không gọn nhưng được cái hoành tráng lệ...

Không biết bác ĐT Nguyễn ở YouTube có tham gia GPE không nhỉ?
Nếu có tham gia mà sao không thấy vào sửa lỗi cho bạn bebeen.

Cách của anh Hải ngắn mà pro quá.

pmhoang · 7/7/15

quanghai1969 đã viết:

Thử code này coi đúng ý không

PHP:

Sub Tonghop()
Dim X, I&, Sh As Worksheet, CurSh As Worksheet, Data()
Set CurSh = Sheets("Data")
X = Application.GetOpenFilename("Excel Files,*.xls?", , , , True)
If Not IsArray(X) Then Exit Sub
For I = 1 To UBound(X)
   With Workbooks.Open(X(I), 0)
      For Each Sh In .Worksheets
         If Sh.Name Like "*REPORT" Then
            Data = Sh.Range("A6", Sh.[A65536].End(3)).Resize(, 7).Value
            CurSh.[A65536].End(3)(2).Resize(UBound(Data), 7) = Data
         End If
      Next
      .Close False
   End With
Next
End Sub

Em thấy câu này chưa hiểu lắm

Dim X, I&,

I & , chử & đặt sau I có nghĩa là gì hả anh?

Ba Tê · 7/7/15

pmhoang đã viết:
Em thấy câu này chưa hiểu lắm

I & , chử & đặt sau I có nghĩa là gì hả anh?

Bạn tìm từ khoá Dim trên GPE là ra ngay, ví dụ như ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?82192-Khai-báo-biến-trong-VBA&p=510742#post510742

Không copy dữ liệu từ các file lẻ sang file có tên master

bebeen

Thành viên thường trực

File đính kèm

Kiều Mạnh

I don't program, I beat code into submission!!!

NH_DK

Let's patience

Kiều Mạnh

I don't program, I beat code into submission!!!

Quang_Hải

Thành viên gạo cội

bebeen

Thành viên thường trực

File đính kèm

Quang_Hải

Thành viên gạo cội

bebeen

Thành viên thường trực

Quang_Hải

Thành viên gạo cội

Đình Phán

Thành viên thường trực

pmhoang

Thành viên thường trực

Ba Tê

Cạo Rồi Khỏi Gội

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng