Nhờ sửa code để file mới tạo có độ rộng cột như file gốc

Chia sẻ bởi:hands
★★★★★
Quảng cáo

Xin chào mọi người,

Mình tìm được file trên mạng, rất mong mọi người giúp mình chỉnh sửa code để tạo ra các file con có độ rộng cột như file gốc ạ. Nếu được, file gốc có định dạng như thế nào, hiển thị như thế nào thì file con cũng như vậy thì càng tốt ạ.

Option Explicit

Sub ExportFiles()
Dim cotcanloc As Integer

Dim arr(), Dic As Object, Rng As Range, Wb As Workbook
Dim i&, k&, endR&, dKey$, fPath$, fName$, tmr#
tmr = Timer()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

cotcanloc = Sheet2.Range("B2").Value

'fPath = "D:" & ""

fPath = Sheet2.Range("B3").Value

If Sheet1.AutoFilterMode Then Sheet1.AutoFilterMode = False
endR = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
Set Rng = Sheet1.Range("A1:ZZ" & endR)
Rng.AutoFilter
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To Rng.Rows.Count
    dKey = Rng(i, cotcanloc)
    If Not Dic.Exists(dKey) Then
        k = k + 1
        Dic.Add dKey, k
        ReDim Preserve arr(1 To k)
        arr(k) = dKey
    End If
Next
For i = 1 To k
    Rng.AutoFilter cotcanloc, arr(i)
    Union(Sheet1.Range("A1:ZZ1"), Rng).SpecialCells(xlCellTypeVisible).Copy
    Set Wb = Workbooks.Add
    Wb.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteAll
    'Workbooks.Sheets("Sheet1").EntireColumn.AutoFit
    fName = arr(i) & Format(Format(Now(), " yymmdd hhmmss")) & ".xlsx"
    Wb.Close True, fPath & fName
    Set Wb = Nothing
Next
Set Dic = Nothing
MsgBox "Done!" & vbNewLine & Timer() - tmr & " seconds"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Sheet1.AutoFilterMode = False
Rng.AutoFilter
End Sub

Mình xin gửi kèm file, cám ơn mọi người rất nhiều ạ.

Thử

Wb.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteAll

thêm dòng này vào :

Wb.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteAll
Wb.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteColumnWidths

www.giaiphapexcel.com/diendan/threads/nh%E1%BB%9D-s%E1%BB%ADa-code-%C4%91%E1%BB%83-file-m%E1%BB%9Bi-t%E1%BA%A1o-c%C3%B3-%C4%91%E1%BB%99-r%E1%BB%99ng-c%E1%BB%99t-nh%C6%B0-file-g%E1%BB%91c.163692/

Khoá học Trưởng phòng nhân sự
Khóa học SprinGO phù hợp

Khoá học Trưởng phòng nhân sự

Nguồn nhân lực là một trong Tứ trụ kinh doanh của doanh nghiệp, có tác động tới sự tồn tại và phát triển bền...

Xem khóa học
★★★★★ 5 ★ 1 👤 0 ▥ 0
Quảng cáo

Bạn nên đọc

Leave a Reply

Your email address will not be published. Required fields are marked *

Quảng cáo

Cũ vẫn chất

Xem thêm