Question

我有以下宏用于复制和粘贴，然后使用工作簿的人转到新创建的工作表并开始删除最终产品不需要的行。我已经尝试添加一行以使宏删除空行，但它不起作用。我想可能是因为它不在活动表上？如果我可以让宏删除我添加到宏的范围内的空行，那么我可以从那里构建;因为我们有很多范围需要查看和删除。我仍然在学习宏，所以你能给我的任何教育都会非常感激。

这是我的宏。这是新工作表中的“删除行”无效。

Sub CopyandPaste()

'Copy and Paste to Worksheets
'

'Select from MASTER sheet
    Range("A1:H1500").Select
    Selection.Copy
' Add new sheet for each Tech
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
'Copy again to paste values
    Range("A1:H1500").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
'Name new sheet Tech's name
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Name = Sheets(Sheets.Count).Range("a2").Value
'Delete blank lines from new sheet
    ActiveSheet.Range("F282:F834").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  End Sub

Answer 1

在大多数情况下，运行时异常是由Select和ActiveSheet方法引起的。

您需要尽可能少地使用它们，而是使用Range和Worksheet变量：

Sub CopyandPaste()

    'Copy and Paste to Worksheets
    '

    'Select from MASTER sheet
     Dim MasterSheet As Worksheet
     Set MasterSheet = Sheets("Master")

     MasterSheet.Range("A1:H1500").Copy


     Dim newSheet As Worksheet
     ' Add new sheet for each Tech
     Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
     newSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
         , SkipBlanks:=False, Transpose:=False
     newSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False

    'Copy again to paste values

     Application.CutCopyMode = False
   'Name new sheet Tech's name
    On Error Resume Next
    Sheets.Item(newSheet.Range("a2").Value).Delete
    On Error GoTo 0

    newSheet.Name = newSheet.Range("a2").Value

    'Delete blank lines from new sheet
        For i = 834 To 282 Step -1
        With newSheet.Cells(i, "F")
            If .Text = "" Then .EntireRow.Delete
        End With
    Next i

End Sub

Answer 2

以下例程就是我如何解决这个问题。包括评论以帮助解释正在发生的事情：

Option Explicit
Sub CopyAndPasteRev2()

Dim Source As Range, Dest As Range, Remove As Range
Dim Master As Worksheet, Target As Worksheet

'set references up-front, assuming you
'start with the MASTER sheet active
Set Master = ThisWorkbook.ActiveSheet
Set Source = Master.Range("A1:H1500")
Set Target = ThisWorkbook.Sheets.Add
Set Dest = Target.Range("A1")

'copy range from master to target
Source.Copy Destination:=Dest

'copy the column width formatting from master to target
Source.Copy
Dest.PasteSpecial (xlPasteColumnWidths)

'remove rows that are blank in col F using
'autofilter to look for empty cells
Dest.AutoFilter
With Target.AutoFilter.Range
    .AutoFilter Field:=6, Criteria1:=vbNullString
    Set Remove = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    Remove.Delete Shift:=xlUp
End With

'clear filters safely
With Target
    .AutoFilterMode = False
    If .FilterMode = True Then
        .ShowAllData
    End If
End With

'move target sheet to be the last one in the workbook
Target.Move After:=ThisWorkbook.Worksheets(Sheets.Count)

End Sub

删除空行

2 个答案: