Question

如果这是一个重复的帖子，请提前道歉 - 我搜索了很长一段时间，无法找到解决我问题的任何内容。我有一个excel电子表格，我想复制到一个新工作簿，然后在新工作簿上执行一些功能，以删除复制内容的各个部分，同时保持原始未更改。

我的代码可以将工作表复制到新工作簿并保存，如下所示：

Dim strFileName As String

'Copy sheet as a new workbook
Sheets("Sheet1").Copy

'SaveAs
strFileName = Application.GetSaveAsFilename(ActiveWorkbook.Name) & "xlsx"
If strFileName = "False" Then Exit Sub 'User Canceled
ActiveWorkbook.SaveAs Filename:=strFileName

我的问题在于在创建新工作簿之后放置我想要使用的代码，以及是否需要添加更多代码来指定我想要执行的工作簿或工作表功能（可能是.Activate或.open？）。下面是我编写的代码，用于删除我不想要的数据，如果我在原始工作表中运行它而不是复制副本，则可以正常运行：

'removes rows when criteria is met
x = 4
Do While Sheet1.Cells(x, 1).Value <> ""
    If (Sheet1.Cells(x, 1) = "Prospect") Or (Sheet1.Cells(x, 1) = "Lead") Then
    Sheet1.Rows(x).Delete
    Else
    x = x + 1
    End If
Loop

'removes rows when criteria is met
y = 4
Do While Sheet1.Cells(y, 5).Value <> ""
    If (Sheet1.Cells(y, 5) = "Non-exclusive") Then
    Sheet1.Rows(y).Delete
    Else
    y = y + 1
    End If
Loop

'removes columns
Sheet1.Columns("P:S").Delete
Sheet1.Columns("F").Delete

简而言之，我如何才能在刚创建的工作表上使用此代码？非常感谢任何帮助，如果我没有澄清一些事情，请随意提问！

Answer 1

在您复制后，设置对工作表的引用，并在代码中使用该引用：

Dim wb as Workbook, sht as WorkSheet
Dim strFileName As String

'Copy sheet as a new workbook
ActiveWorkbook.Sheets("Sheet1").Copy

Set wb = ActiveWorkbook
Set sht = wb.Sheets(1)

'SaveAs
strFileName = Application.GetSaveAsFilename(wb.Name) & ".xlsx"
If strFileName = "False" Then Exit Sub 'User Canceled
wb.SaveAs Filename:=strFileName

'removes rows when criteria is met
x = 4
Do While sht.Cells(x, 1).Value <> ""
    If sht.Cells(x, 1) = "Prospect" Or sht.Cells(x, 1) = "Lead" Then
    sht.Rows(x).Delete
    Else
    x = x + 1
    End If
Loop

'removes rows when criteria is met
y = 4
Do While sht.Cells(y, 5).Value <> ""
    If sht.Cells(y, 5) = "Non-exclusive" Then
    sht.Rows(y).Delete
    Else
    y = y + 1
    End If
Loop

'removes columns
sht.Columns("P:S").Delete
sht.Columns("F").Delete

使用Excel VBA将工作表复制到新工作簿并更改新工作簿

1 个答案: