Gộp nhiều file nối tiếp nhau mà không cần mở hộp chọn

rdxls

Thành viên mới
Tham gia ngày
6 Tháng một 2019
Bài viết
6
Được thích
1
Điểm
15
Yêu cầu:
- Tư tìm file dựa vào đặc điểm tên của file
- Ghi nối tiếp nhau

Trong file đính kèm, em có 2 đoạn code:
- Code GopFileExcel: đúng với yêu cầu là ghi nối tiếp, nhưng sử dụng hộp chọn
- Code ImportSheets: đúng với yêu cầu là tự tìm file, nhưng không ghi nối tiếp

Làm sao để kết hợp 2 code này lại để có thể được như yêu cầu ạ. Xin giúp đỡ.
 

File đính kèm

batman1

Thành viên gắn bó
Tham gia ngày
8 Tháng chín 2014
Bài viết
2,033
Được thích
3,176
Điểm
560
Tức bạn muốn làm y như code gộp nhưng không hiện hộp thoại mà code tự lấy tất cả các tập tin dạng XLSX?
Nếu thế thì vấn đề cụ thể này của bạn có thể giải quyết như sau. Tôi chả sửa, cũng chả làm cách khác mà chỉ gộp 2 code thành một thôi. Chẳng qua là lấy gương mặt thiên thần của cô A, lấy đường cong của cô B, và lấy sự dịu dàng của cô C để tạo cô D hoàn hảo. Thế thôi.
Mã:
Sub Gop()
Dim x As Integer, directory As String, fileName As String, wb As Workbook

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    directory = (ThisWorkbook.Path & "\")
    fileName = Dir(directory & "*.xlsx")
    
    Do While fileName <> ""
        Set wb = Workbooks.Open(fileName)
            
        If x = 0 Then
            wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
        Else
            lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
            wb.Sheets(1).UsedRange.Offset(1).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)
        End If
        
        wb.Close False
        x = x + 1
        fileName = Dir()
    Loop
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub
 

rdxls

Thành viên mới
Tham gia ngày
6 Tháng một 2019
Bài viết
6
Được thích
1
Điểm
15
Tức bạn muốn làm y như code gộp nhưng không hiện hộp thoại mà code tự lấy tất cả các tập tin dạng XLSX?
Nếu thế thì vấn đề cụ thể này của bạn có thể giải quyết như sau. Tôi chả sửa, cũng chả làm cách khác mà chỉ gộp 2 code thành một thôi. Chẳng qua là lấy gương mặt thiên thần của cô A, lấy đường cong của cô B, và lấy sự dịu dàng của cô C để tạo cô D hoàn hảo. Thế thôi.
Vẫn chưa thấy được cô D ạ. Báo lỗi không tìm thấy cô A, B, C. Anh xem lại giúp em ạ.
 

File đính kèm

Nguyễn Hoàng Oanh Thơ

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,016
Được thích
393
Điểm
235
Nơi ở
Hà Nội
Vẫn chưa thấy được cô D ạ. Báo lỗi không tìm thấy cô A, B, C. Anh xem lại giúp em ạ.
Bạn thử sửa dòng:
Set wb = Workbooks.Open(fileName)
Thành:
Set wb = Workbooks.Open(directory & fileName)
Và đề phòng lỗi "Variable not defined" xảy ra thì bạn khai báo thêm biến "lr " :
Sau dòng:
Dim x As Integer, directory As String, fileName As String, wb As Workbook
Thêm:
 

tam888

Thành viên tích cực
Tham gia ngày
22 Tháng tám 2013
Bài viết
840
Được thích
498
Điểm
435
Tức bạn muốn làm y như code gộp nhưng không hiện hộp thoại mà code tự lấy tất cả các tập tin dạng XLSX?
Nếu thế thì vấn đề cụ thể này của bạn có thể giải quyết như sau. Tôi chả sửa, cũng chả làm cách khác mà chỉ gộp 2 code thành một thôi. Chẳng qua là lấy gương mặt thiên thần của cô A, lấy đường cong của cô B, và lấy sự dịu dàng của cô C để tạo cô D hoàn hảo. Thế thôi.
Mã:
Sub Gop()
Dim x As Integer, directory As String, fileName As String, wb As Workbook

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
  
    directory = (ThisWorkbook.Path & "\")
    fileName = Dir(directory & "*.xlsx")
  
    Do While fileName <> ""
        Set wb = Workbooks.Open(fileName)
          
        If x = 0 Then
            wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
        Else
            lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
            wb.Sheets(1).UsedRange.Offset(1).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)
        End If
      
        wb.Close False
        x = x + 1
        fileName = Dir()
    Loop
  
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub
Kiểu này bác muốn 1 nhát chém nhiều, lầm còn hơn bỏ sót đây, đúng ý kiến chủ topic (ghép đại nhiều file)
 

quick87

(/ội...
Tham gia ngày
8 Tháng tư 2008
Bài viết
180
Được thích
144
Điểm
680

Nguyễn Hoàng Oanh Thơ

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,016
Được thích
393
Điểm
235
Nơi ở
Hà Nội
Bạn thử code sau xem sao ạ:
Mã:
Sub Gop_2()
    
    Dim x As Integer, directory As String, fileName As String, wb As Workbook
    Dim ws As Worksheet, lc As Long, lr As Long, lr2 As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    directory = (ThisWorkbook.Path & "\")
    fileName = Dir(directory & "*.xlsx")
    Set ws = ThisWorkbook.Sheets(1)
    Do While fileName <> ""
        Set wb = Workbooks.Open(directory & fileName)
        If x = 0 Then
            wb.Sheets(1).UsedRange.Copy ws.Range("A1")
                lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
                lr = ws.UsedRange.Rows.Count
            If ws.Cells(1, lc).Value <> "Tên file" Then
                ws.Cells(1, lc + 1).Value = "Tên file"
                ws.Cells(2, lc + 1).Resize(lr - 1).Value = fileName
            End If
        Else
            lr = ws.UsedRange.Rows.Count
            wb.Sheets(1).UsedRange.Offset(1).Copy ws.Range("A" & lr + 1)
            lr2 = wb.Sheets(1).UsedRange.Rows.Count
            lc = ws.Cells(lr + 1, ws.Columns.Count).End(xlToLeft).Column
            ws.Cells(lr + 1, lc + 1).Resize(lr2 - 1).Value = fileName
        End If
        wb.Close False
        x = x + 1
        fileName = Dir()
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub
 
Lần chỉnh sửa cuối:
Top Bottom