ùa! xin lỗi..
Mình có 1 file khác muốn chỉnh cho code chạy theo file đó chiều cột khác 1 chút bạn chỉ cho mình thay đổi như thông số nào trong code với, bạn bôi mầu ở vị trí thay đổi nhé
--------------------------
Sub fixdongsheetlist()
Dim headRowHei As Double, pageHei As Double, tRowHei As Double, shNames As Range
Dim ws As Worksheet, r As Long, lrPrint As Long, arr As Variant, lrCT As Long, frCT As Long, signRow As Long
Application.ScreenUpdating = False
Set shNames = Worksheets("Danh Sach Fix").Range("B1:B" & Worksheets("Danh Sach Fix").Range("B50000").End(xlUp).Row)
For Each ws In Worksheets
If TypeName(Application.Match(ws.Name, shNames, 0)) <> "Error" Then
With ws
ws.Activate
lrPrint = .[B50000].End(xlUp).Row
.Range("A1:A" & lrPrint).EntireRow.Hidden = False
arr = .Range("B1
" & lrPrint).Value
For r = UBound(arr) To 1 Step -1
If WorksheetFunction.Trim(arr(r, 1)) <> "" And Not IsNumeric(arr(r, 1)) Then signRow = r
If Val(arr(r, 1)) <> 0 Or Val(arr(r, 3)) <> 0 Then
lrCT = r
Exit For
End If
Next
.PageSetup.PrintArea = "B1:G" & (lrPrint + 200)
ActiveWindow.View = xlPageBreakPreview
frCT = .Rows(.PageSetup.PrintTitleRows).Row + .Rows(.PageSetup.PrintTitleRows).Rows.Count
.Rows(frCT & ":" & lrPrint).RowHeight = 14
If lrCT < signRow - 1 Then
.Rows((lrCT + 1) & ":" & (signRow - 1)).Hidden = True
End If
For r = 1 To .HPageBreaks.Count Step 1
If lrCT - 4 < .HPageBreaks(r).Location.Row And lrPrint >= .HPageBreaks(r).Location.Row Then
headRowHei = .Rows(.PageSetup.PrintTitleRows).Height
pageHei = 11.7 * 72 - .PageSetup.TopMargin - .PageSetup.BottomMargin + r + 2
tRowHei = (r * pageHei - r * headRowHei - .Range("A1:A" & _
(.Rows(.PageSetup.PrintTitleRows).Row - 1)).Height) / (lrCT - frCT - 4)
.Rows(frCT & ":" & lrCT).RowHeight = tRowHei
Exit For
End If
Next
.PageSetup.PrintArea = "B1:G" & lrPrint
ActiveWindow.View = xlNormalView
End With
End If
Next
Application.ScreenUpdating = True
End Sub
