Nhờ các bạn GPE giúp mình sửa công thức sao chép file

[acrox84]

Lúc trước mình đã được các bạn hỗ trợ làm 1 file tool chức năng: ghép thông tin bảng dulieu2.xlsx & dulieu1.xlsx thành file mới: dulieu.xlsx với đủ thông tin 2 file. Do file cần ghép mới có sự thay đổi là thêm 8 dòng tiêu đề định dạng thừa, bảng thông tin bắt đầu từ dòng 9 mà mình không hiểu code lại, nên edit tới lui vẫn không ra được kết quả mong muốn



*Yêu cầu nhờ hỗ trợ là: Tạo ra file dulieu.xlsx, là gộp thông tin của file dulieu1.xlsx và dulieu2.xlsx, trong đó chỉ lấy thông tin dulieu2 từ dòng 10 và chép tiếp nối bảng dulieu1 từ dòng 20. Đây chỉ là ví dụ minh họa, thực tế mỗi file có từ 100 - 200 dòng.

File kết quả: dulieu.xlsx mong muốn là:



*Mình xin đính kèm lại code cũ & đính kèm 3 file excel trong bài, nhờ các bạn trợ giúp, Chân thành cảm ơn!!

Option Explicit

Private Sub CommandButton1_Click()

Dim wb As Workbook, wbNew As Workbook, ws As Worksheet, wsNew As Worksheet, col As Range, colNew As Range
Dim lastRow As Long, lastCol As Long, lastRowNew As Long
Dim colTitle As String, sFolder As String, newFileName As String, filePath As String
Dim fso As Object, fileNames As Variant, fileName As Variant

getSpeed True
On Error GoTo End_
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = Me.Range("C4").Value

If Not fso.FolderExists(sFolder) Then
MsgBox "Khong tim thay thu muc: " & vbNewLine & sFolder, vbCritical
GoTo End_
End If
fileNames = Split(Me.Range("C6").Value, ";")
Set wbNew = Workbooks.Add: Set wsNew = wbNew.Worksheets(1)
lastRowNew = 1
For Each fileName In fileNames
filePath = sFolder & "\" & fileName
If Not fso.FileExists(filePath) Then
MsgBox "Khong tim thay tap tin: " & vbNewLine & filePath, vbCritical
GoTo End_
End If
Set wb = Workbooks.Open(filePath): Set ws = wb.Worksheets(1)
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
If lastRowNew = 1 Then
ws.UsedRange.Copy Destination:=wsNew.Cells(lastRowNew, 1)
lastRowNew = lastRow
Else
For Each col In ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol))
colTitle = col.Cells(1).Value
Set colNew = wsNew.Rows(1).Find(colTitle, LookIn:=xlValues, LookAt:=xlWhole)
If Not colNew Is Nothing Then
ws.Range(col.Cells(2), col.Cells(lastRow)).Copy Destination:=wsNew.Cells(wsNew.Cells(wsNew.Rows.Count, colNew.Column).End(xlUp).Row + 1, colNew.Column)
End If
Next col
lastRowNew = lastRowNew + lastRow - 1
End If
wb.Close SaveChanges:=False
Next fileName

newFileName = "dulieu" & ".xlsx"
wbNew.SaveAs sFolder & "\" & newFileName
wbNew.Close SaveChanges:=False
MsgBox "Done! Da gop dulieu"

End_:
getSpeed False

End Sub

 

[HUONGHCKT]

Lúc trước mình đã được các bạn hỗ trợ làm 1 file tool chức năng: ghép thông tin bảng dulieu2.xlsx & dulieu1.xlsx thành file mới: dulieu.xlsx với đủ thông tin 2 file. Do file cần ghép mới có sự thay đổi là thêm 8 dòng tiêu đề định dạng thừa, bảng thông tin bắt đầu từ dòng 9 mà mình không hiểu code lại, nên edit tới lui vẫn không ra được kết quả mong muốn

*Mình xin đính kèm lại code cũ & đính kèm 3 file excel trong bài, nhờ các bạn trợ giúp, Chân thành cảm ơn!!

Tham khảo code sau: vẫn là code cũ sửa lại tý chút. Trên máy tôi là chạy êm (định dạng đúng như file gốc)

Private Sub CommandButton1_Click()

    Dim wb As Workbook, wbNew As Workbook, ws As Worksheet, wsNew As Worksheet, col As Range, colNew As Range, Rng As Range
    Dim lastRow As Long, lastCol As Long, lastRowNew As Long, d&
    Dim colTitle As String, sFolder As String, newFileName As String, filePath As String
    Dim fso As Object, fileNames As Variant, fileName As Variant
    
    getSpeed True
    On Error GoTo End_
    Set fso = CreateObject("Scripting.FileSystemObject")
    sFolder = Me.Range("C4").Value
    
    If Not fso.FolderExists(sFolder) Then
        MsgBox "Khong tim thay thu muc: " & vbNewLine & sFolder, vbCritical
        GoTo End_
    End If
    fileNames = Split(Me.Range("C6").Value, ";")
    Set wbNew = Workbooks.Add:  Set wsNew = wbNew.Worksheets(1)
    lastRowNew = 1
    For Each fileName In fileNames
        filePath = sFolder & "\" & fileName
        If Not fso.FileExists(filePath) Then
            MsgBox "Khong tim thay tap tin: " & vbNewLine & filePath, vbCritical
            GoTo End_
        End If
        Set wb = Workbooks.Open(filePath):  Set ws = wb.Worksheets(1)
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.UsedRange.Columns.Count
        If lastRowNew = 1 Then
ws.UsedRange.Copy
wsNew.Activate
wsNew.Cells(lastRowNew, 1).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone
ActiveSheet.Paste
            lastRowNew = lastRow
        Else
            Set Rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 1))
                Set colNew = Rng.Find("STT", LookIn:=xlValues, LookAt:=xlWhole)
                If Not colNew Is Nothing Then
d = colNew.Row + 1
                    ws.Range(ws.Cells(d, 1), ws.Cells(lastRow, lastCol)).Copy Destination:=wsNew.Cells(lastRowNew + 1, 1)
                End If
            lastRowNew = lastRowNew + lastRow - 1
        End If
        wb.Close SaveChanges:=False
    Next fileName
    
    newFileName = "dulieu" & ".xlsx"
    wbNew.SaveAs sFolder & "\" & newFileName
    wbNew.Close SaveChanges:=False
    MsgBox "Done! Da gop dulieu"

End_:
    getSpeed False
    
End Sub

 

[hvnhpro]

Hỏi nhờ ông chú "Viettel" chút, mình đang hiểu bạn đang muốn gộp các file cần gộp có phải là các file cùng định dạng lấy từ 1 nguồn
Nên mình khái quát thêm phần này lên như thế này nhé. File Tools_HNP này cần cải tiến thêm
a) 1 trường là vùng tiêu đề bạn cần gộp - để có thể hiểu vùng cần gộp và vùng dưới vùng này. ví dụ như file của bạn là A9:AS9. Sẽ giúp bạn tùy biến khi file nguồn bạn thay đổi
b) thêm phần duyệt file chọn gộp chứ không phải điền tay vào ô C6 nữa.
Bạn thấy đúng ý bạn không thì mình sẽ sửa lại code cho bạn.

 

[acrox84]

Tham khảo code sau: vẫn là code cũ sửa lại tý chút. Trên máy tôi là chạy êm (định dạng đúng như file gốc)

Private Sub CommandButton1_Click()

    Dim wb As Workbook, wbNew As Workbook, ws As Worksheet, wsNew As Worksheet, col As Range, colNew As Range, Rng As Range
    Dim lastRow As Long, lastCol As Long, lastRowNew As Long, d&
    Dim colTitle As String, sFolder As String, newFileName As String, filePath As String
    Dim fso As Object, fileNames As Variant, fileName As Variant
  
    getSpeed True
    On Error GoTo End_
    Set fso = CreateObject("Scripting.FileSystemObject")
    sFolder = Me.Range("C4").Value
  
    If Not fso.FolderExists(sFolder) Then
        MsgBox "Khong tim thay thu muc: " & vbNewLine & sFolder, vbCritical
        GoTo End_
    End If
    fileNames = Split(Me.Range("C6").Value, ";")
    Set wbNew = Workbooks.Add:  Set wsNew = wbNew.Worksheets(1)
    lastRowNew = 1
    For Each fileName In fileNames
        filePath = sFolder & "\" & fileName
        If Not fso.FileExists(filePath) Then
            MsgBox "Khong tim thay tap tin: " & vbNewLine & filePath, vbCritical
            GoTo End_
        End If
        Set wb = Workbooks.Open(filePath):  Set ws = wb.Worksheets(1)
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.UsedRange.Columns.Count
        If lastRowNew = 1 Then
ws.UsedRange.Copy
wsNew.Activate
wsNew.Cells(lastRowNew, 1).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone
ActiveSheet.Paste
            lastRowNew = lastRow
        Else
            Set Rng = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 1))
                Set colNew = Rng.Find("STT", LookIn:=xlValues, LookAt:=xlWhole)
                If Not colNew Is Nothing Then
d = colNew.Row + 1
                    ws.Range(ws.Cells(d, 1), ws.Cells(lastRow, lastCol)).Copy Destination:=wsNew.Cells(lastRowNew + 1, 1)
                End If
            lastRowNew = lastRowNew + lastRow - 1
        End If
        wb.Close SaveChanges:=False
    Next fileName
  
    newFileName = "dulieu" & ".xlsx"
    wbNew.SaveAs sFolder & "\" & newFileName
    wbNew.Close SaveChanges:=False
    MsgBox "Done! Da gop dulieu"

End_:
    getSpeed False
  
End Sub

mình dùng thử thì thấy có copy được, nhưng mà mỗi lần chạy hiện thông báo thế này, click Yes mới thực thi và thực thi ra file New Book excel mới, mình dùng phải rename tên file thành dulieu.xlsx lần nữa. File code cũ thì tự chạy không hỏi và tự tạo file dulieu trong cùng cấp thư mục luôn ạ

Bài đã được tự động gộp: 26/11/24

Hỏi nhờ ông chú "Viettel" chút, mình đang hiểu bạn đang muốn gộp các file cần gộp có phải là các file cùng định dạng lấy từ 1 nguồn
Nên mình khái quát thêm phần này lên như thế này nhé. File Tools_HNP này cần cải tiến thêm
a) 1 trường là vùng tiêu đề bạn cần gộp - để có thể hiểu vùng cần gộp và vùng dưới vùng này. ví dụ như file của bạn là A9:AS9. Sẽ giúp bạn tùy biến khi file nguồn bạn thay đổi
b) thêm phần duyệt file chọn gộp chứ không phải điền tay vào ô C6 nữa.
Bạn thấy đúng ý bạn không thì mình sẽ sửa lại code cho bạn.

Đúng rồi, file cần gộp là cùng định dạng và lấy từ 1 nguồn. Nếu được khái quát rộng hơn để mình tự chỉnh sửa sau này thì thật dễ cho mình:
a) Vùng tiêu đề lâu lâu thay đổi định dạng, lúc trước tải file về là dòng 1 luôn, giờ nó đẩy dữ liệu cần tới dòng 9, sau này có khi lại thay đổi nữa.
b) Khi mình tải file, tên file rất dài chỉ khác kí hiệu ở cuối, khi tải về nhiều file, lúc chọn file duyệt sợ bị nhầm dữ liệu nên mình muốn tải về file mới là đổi tên tay thành dulieu1, dulieu2 cho khỏi chọn nhầm ạ
*Rất mong bạn giúp mình cải tiến code để mình dễ dùng hơn

 

[HUONGHCKT]

mình dùng thử thì thấy có copy được, nhưng mà mỗi lần chạy hiện thông báo thế này, click Yes mới thực thi và thực thi ra file New Book excel mới, mình dùng phải rename tên file thành dulieu.xlsx lần nữa. File code cũ thì tự chạy không hỏi và tự tạo file dulieu trong cùng cấp thư mục luôn ạ
View attachment 305882

Bài đã được tự động gộp: 26/11/24

Đúng rồi, file cần gộp là cùng định dạng và lấy từ 1 nguồn. Nếu được khái quát rộng hơn để mình tự chỉnh sửa sau này thì thật dễ cho mình:
a) Vùng tiêu đề lâu lâu thay đổi định dạng, lúc trước tải file về là dòng 1 luôn, giờ nó đẩy dữ liệu cần tới dòng 9, sau này có khi lại thay đổi nữa.
b) Khi mình tải file, tên file rất dài chỉ khác kí hiệu ở cuối, khi tải về nhiều file, lúc chọn file duyệt sợ bị nhầm dữ liệu nên mình muốn tải về file mới là đổi tên tay thành dulieu1, dulieu2 cho khỏi chọn nhầm ạ
*Rất mong bạn giúp mình cải tiến code để mình dễ dùng hơn

Thế lúc trước khi sửa code bạn chạy nó có bị lỗi này không?
Tôi thấy bạn nói dùng tool đã được nên hy vọng bạn tự sửa được.
Bạn thêm dòng Tô đậm này vào Đầu code (ngay sau dòng khai báo biến)
......
getSpeed True
Application.DisplayAlerts = False
......
và
trước khi and sub
......
getSpeed True
Application.DisplayAlerts = True
End dub

 

[hvnhpro]

Mình thấy bác HUONGHCKT, đã giúp bạn xác định tiều đề theo "STT" rồi. Trừ khi file đổi tên trường này.

mình dùng thử thì thấy có copy được, nhưng mà mỗi lần chạy hiện thông báo thế này, click Yes mới thực thi và thực thi ra file New Book excel mới, mình dùng phải rename tên file thành dulieu.xlsx lần nữa. File code cũ thì tự chạy không hỏi và tự tạo file dulieu trong cùng cấp thư mục luôn ạ
View attachment 305882

Bài đã được tự động gộp: 26/11/24

Đúng rồi, file cần gộp là cùng định dạng và lấy từ 1 nguồn. Nếu được khái quát rộng hơn để mình tự chỉnh sửa sau này thì thật dễ cho mình:
a) Vùng tiêu đề lâu lâu thay đổi định dạng, lúc trước tải file về là dòng 1 luôn, giờ nó đẩy dữ liệu cần tới dòng 9, sau này có khi lại thay đổi nữa.
b) Khi mình tải file, tên file rất dài chỉ khác kí hiệu ở cuối, khi tải về nhiều file, lúc chọn file duyệt sợ bị nhầm dữ liệu nên mình muốn tải về file mới là đổi tên tay thành dulieu1, dulieu2 cho khỏi chọn nhầm ạ
*Rất mong bạn giúp mình cải tiến code để mình dễ dùng hơn

 

[HUONGHCKT]

Mình thấy bác HUONGHCKT, đã giúp bạn xác định tiều đề theo "STT" rồi. Trừ khi file đổi tên trường này.

Mình thấy bác HUONGHCKT, đã giúp bạn xác định tiều đề theo "STT" rồi. Trừ khi file đổi tên trường này.

Cách của tôi, thì nếu dòng tiêu đề ở dòng nào cũng được miễn là ở cột A có "STT". Còn nếu làm để dẽ sửa thì dùng 1 ô ở sh chứa code ghi trên đó vùng dữ liệu Ví dụ Ô B1= từ . C1=10. (có nghĩa là lấy từ dòng 10 trở xuống), số cột thì dùng code để tim hoặc cũng tương tự như dòng. Trong code các ô này là thay dòng Lastrow, và lastcol. Chưa thử nhưng tin chắc là được.

 

[acrox84]

Cách của tôi, thì nếu dòng tiêu đề ở dòng nào cũng được miễn là ở cột A có "STT". Còn nếu làm để dẽ sửa thì dùng 1 ô ở sh chứa code ghi trên đó vùng dữ liệu Ví dụ Ô B1= từ . C1=10. (có nghĩa là lấy từ dòng 10 trở xuống), số cột thì dùng code để tim hoặc cũng tương tự như dòng. Trong code các ô này là thay dòng Lastrow, và lastcol. Chưa thử nhưng tin chắc là được.

mình làm được rồi, cảm ơn 2 bạn đã hỗ trợ mình chỉnh sửa code.
Cho mình hỏi cái, hàm Application.DisplayAlerts = False chỗ thêm dễ rồi, còn bật lại để cuối code, trên dòng End sub như vậy đúng ko ạ

*Chức năng của nó là tắt toàn bộ thông báo, rồi sau khi thực hiện code xong mở lại chức năng này hay sao ạ. Lúc trước mình dùng thì ko có hiển thị thông báo xác nhận này

 

[HUONGHCKT]

mình làm được rồi, cảm ơn 2 bạn đã hỗ trợ mình chỉnh sửa code.
Cho mình hỏi cái, hàm Application.DisplayAlerts = False chỗ thêm dễ rồi, còn bật lại để cuối code, trên dòng End sub như vậy đúng ko ạ

*Chức năng của nó là tắt toàn bộ thông báo, rồi sau khi thực hiện code xong mở lại chức năng này hay sao ạ. Lúc trước mình dùng thì ko có hiển thị thông báo xác nhận này

View attachment 305892

Đúng rồi. khi vào sub thì tắt các thông báo, sau khi chạy xong rồi thì phải trả lại cho nó về True chứ.