Nhờ sửa code để file mới tạo có độ rộng cột như file gốc
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 SubMì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/
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