Sub CopyVisibleToNewSheet() Dim Wb As Workbook Dim Sht As Worksheet Dim NewSht As Worksheet Dim Rng As Range Set Wb = Application.ThisWorkbook Set Sht = Wb.ActiveSheet With Sht Set Rng = .UsedRange.SpecialCells(xlCellTypeVisible) Debug.Print Rng.Address End With Set NewSht = Wb.Worksheets.Add(After:=Wb.Worksheets(Wb.Worksheets.Count)) NewSht.Name = "复制可见单元格" & Wb.Worksheets.Count Rng.Copy NewSht.Range("A1") A4PageSetup NewSht Set Wb = Nothing Set Sht = Nothing Set Rng = Nothing Set NewSht = Nothing End Sub Private Sub A4PageSetup(ByVal Sht) Application.PrintCommunication = False Dim Rng As Range With Sht Set Rng = .UsedRange SetCenters Rng End With With Sht.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" .PrintArea = Rng.Address .LeftMargin = Application.InchesToPoints(0.236220472440945) .RightMargin = Application.InchesToPoints(0.236220472440945) .TopMargin = Application.InchesToPoints(0.590551181102362) .BottomMargin = Application.InchesToPoints(0.590551181102362) .HeaderMargin = Application.InchesToPoints(0.31496062992126) .FooterMargin = Application.InchesToPoints(0.31496062992126) .PrintComments = xlPrintNoComments .CenterHorizontally = True '水平居中 .CenterVertically = True '垂直居中 .Orientation = xlPortrait '纵向 .PaperSize = xlPaperA4 '纸张大小 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = True .FitToPagesWide = 1 '一页宽度 .FitToPagesTall = 1 '一页高度 .PrintErrors = xlPrintErrorsDisplayed .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = True End With Set Rng = Nothing Application.PrintCommunication = True End Sub Private Sub SetCenters(ByVal Rng As Range) With Rng .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Columns.AutoFit End With End Sub