在 Excel 中使用 VBA 在不同的工作表上打印行
Use VBA in Excel to print rows on different worksheet
我在一个包含数千行信息的工作簿中有三个单独的工作sheet,并且经常添加新信息。我希望能够使用宏创建单独的报告,并且 VBA 在我需要报告时打印到另一个作品上 sheet。
例如,报告一将包括 2014 年所有已完成的工作。如果已完成?等于 YES,Year 等于 2014,在空白处打印整行 sheet。但是,我需要使用 VBA,因此它会经历三个工作sheet,然后将它们一起打印在一个单独的工作sheet 中。我该怎么做?
说明:基本上,如果这两个单元格等于这个和这个,则在不同的 sheet.
上打印该行
练习这个。
在带有数据的 sheet 上插入按钮或其他类型的对象。
单击代码后,将删除除活动 sheet 之外的所有 sheet。
然后循环遍历 A 列并创建 sheet。
然后它循环遍历 sheet 并过滤您的数据 sheet,将数据复制并粘贴到 sheet 中并移动到下一个 sheet。
Sub getSht()
Dim c As Range, sh As Worksheet
Dim Rws As Long, Rng As Range, fRng As Range
Dim ws As Worksheet
Set ws = ActiveSheet
Application.DisplayAlerts = 0
Application.ScreenUpdating = 0
For Each sh In Sheets
If sh.Name <> ws.Name Then sh.Delete
Next sh
With ws
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = .Range(.Cells(2, 1), .Cells(Rws, 1))
For Each c In Rng.Cells
If WorksheetExists(c.Value) Then
Else: Sheets.Add.Name = c
End If
Next c
End With
For Each sh In Sheets
If sh.Name <> ws.Name Then
ws.Range("A:A").AutoFilter Field:=1, Criteria1:=sh.Name
Set fRng = ws.Range(ws.Cells(1, "A"), ws.Cells(Rws, "D"))
fRng.Copy Destination:=sh.Range("A1")
End If
ws.AutoFilterMode = 0
Next sh
ws.Activate
End Sub
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function
我在一个包含数千行信息的工作簿中有三个单独的工作sheet,并且经常添加新信息。我希望能够使用宏创建单独的报告,并且 VBA 在我需要报告时打印到另一个作品上 sheet。
例如,报告一将包括 2014 年所有已完成的工作。如果已完成?等于 YES,Year 等于 2014,在空白处打印整行 sheet。但是,我需要使用 VBA,因此它会经历三个工作sheet,然后将它们一起打印在一个单独的工作sheet 中。我该怎么做?
说明:基本上,如果这两个单元格等于这个和这个,则在不同的 sheet.
上打印该行练习这个。 在带有数据的 sheet 上插入按钮或其他类型的对象。
单击代码后,将删除除活动 sheet 之外的所有 sheet。
然后循环遍历 A 列并创建 sheet。 然后它循环遍历 sheet 并过滤您的数据 sheet,将数据复制并粘贴到 sheet 中并移动到下一个 sheet。
Sub getSht()
Dim c As Range, sh As Worksheet
Dim Rws As Long, Rng As Range, fRng As Range
Dim ws As Worksheet
Set ws = ActiveSheet
Application.DisplayAlerts = 0
Application.ScreenUpdating = 0
For Each sh In Sheets
If sh.Name <> ws.Name Then sh.Delete
Next sh
With ws
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = .Range(.Cells(2, 1), .Cells(Rws, 1))
For Each c In Rng.Cells
If WorksheetExists(c.Value) Then
Else: Sheets.Add.Name = c
End If
Next c
End With
For Each sh In Sheets
If sh.Name <> ws.Name Then
ws.Range("A:A").AutoFilter Field:=1, Criteria1:=sh.Name
Set fRng = ws.Range(ws.Cells(1, "A"), ws.Cells(Rws, "D"))
fRng.Copy Destination:=sh.Range("A1")
End If
ws.AutoFilterMode = 0
Next sh
ws.Activate
End Sub
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function