如果存在则复制工作表,如果不存在则创建新文件



嗨,你可以帮助弄清楚如何复制工作表,如果它存在,如果它不将自动创建一个新的工作簿,然后保存为空白。请参阅我的代码下面我尝试它,如果文件是现有的复制文件,如果没有创建一个新的空白文件。

Workbooks.Open path1
Sheets.Select
If Sheets("Draft") = "" Then
Set wb = Workbooks.Add
ActiveWorkbook.SaveAs saveFolder & "D201D201.xlsx", FileFormat:=51
ActiveWorkbook.Close
Else
Sheets("Draft").Copy
ActiveWorkbook.SaveAs saveFolder & "D201D201.xlsx", FileFormat:=51
Workbooks(file1).Close
ActiveWorkbook.Close
End If

,我遇到了一个错误,它说下标超出范围

很确定您没有真正努力(因为调试抛出的错误会导致您出现明显的错误)。😊
这里有两种可能的方法来测试是否存在具有特定名称的工作表:


Sub Temp()
''' Two possible ways to determine if a sheet with a specific name exists
''' Both assume you're looking for the sheet in the Active Book
''' There are other ways

''' Sledge hammer approach (very efficient)
Dim lgErr&
On Error Resume Next: Err.Clear
With Sheets("Draft"): End With: lgErr = Err
On Error GoTo 0
If lgErr <> 0 Then
' Sheets("Draft") does not exist in the active workbook
Else
' Sheets("Draft") does exist in the active workbook
End If
''' More subtle approach (just as effective and only marginally less efficient)
Dim in1%
For in1 = 1 To Sheets.Count
If Sheets(in1).Name = "Draft" Then Exit For
Next in1
If in1 > Sheets.Count Then
' Sheets("Draft") does not exist in the active workbook
Else
' Sheets("Draft") does exist in the active workbook
End If
End Sub

注意:
第一种方法通常被对自己的vba技能有信心的人使用。
风险在于,在"On error Resume Next"one_answers"On error GoTo 0"之间的编码错误可能导致无效结论。
第二种方法没有同样的风险。

我通常使用一个函数来测试工作簿中是否存在工作表:


Function Feuille_Existe(ByVal Nom_Feuille As String) As Boolean
Dim Feuille As Excel.Worksheet
On Error GoTo Feuille_Absente_Error
Set Feuille = ActiveWorkbook.Worksheets(Nom_Feuille)
On Error GoTo 0
Feuille_Existe = True
Exit Function
Feuille_Absente_Error:
Feuille_Existe = False
End Function

把它放在模块的顶部,当你在代码中需要它的时候:

If Feuille_Existe("XXX") Then
'do what you want'
End If

相关内容