从VBA(Excel)中的工作簿创建新工作表

Question

If WSheetFound Then 'if WSheetFound = True
'copy and paste the record to the relevant worksheet, in the next available row
internal_numberName.Offset(0, -3).Resize(1, 10).Copy Destination:=Worksheets(internal_numberName.Value).Range("A1").End(xlDown).Offset(1, 0)
Else 'if WSheetFound = False

Set NewWSheet = Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ' insert a new Worksheet
NewWSheet.Name = internal_numberName 'named after that branch

DataWSheet.Range("A1", DataWSheet.Range("A1").End(xlToRight)).Copy Destination:=NewWSheet.Range("A1") 'and copy the headings to it

internal_numberName.Offset(0, -3).Resize(1, 10).Copy Destination:=NewWSheet.Range("A2") ' then copy and paste the record to i

End If

当创建标题时，尝试从A2添加内容时失败了，有人能在这个上帮我吗

Answer 1

如果不存在添加新工作表

• 我唯一能产生的错误是，当internal_numberName包含一个数字时，"If"语句中的第一行将失败，这在...Worksheets(CStr(internal_numberName.Value))...中很容易避免
• 这些"无法解释"的错误通常发生在代码前面的某个位置有On Error Resume Next时。如果是这种情况，请删除它，因为它"隐藏"了以前发生的一个或多个错误
• 如果发布的代码没有帮助，您将需要披露更多的代码，最好是全部代码
• 下面的代码消除了对函数或用于确定目标工作表是否已经存在的任何函数的需要

Option Explicit
Sub Test()

Dim DataWSheet As Worksheet ' Source Worksheet
Set DataWSheet = ThisWorkbook.Worksheets("Sheet1")
Dim internal_numberName As Range
Set internal_numberName = DataWSheet.Range("D2")

' The above is irrelevant for your code, it's just for testing purposes.

Dim NewName As String: NewName = CStr(internal_numberName.Value)

Dim NewWSheet As Worksheet ' Destination Worksheet
Dim srg As Range ' Source Range
Dim dfCell As Range ' Destination First Cell

' Reference the destination worksheet.

' Attempt to reference the worksheet.
Set NewWSheet = Nothing ' necessary if in a loop
On Error Resume Next ' defer error trapping
Set NewWSheet = ThisWorkbook.Worksheets(NewName)
On Error GoTo 0 ' stop error trapping

If NewWSheet Is Nothing Then ' worksheet doesn't exist
Set NewWSheet = ThisWorkbook.Worksheets _
.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
NewWSheet.Name = NewName
DataWSheet.Range("A1", DataWSheet.Cells(1, DataWSheet.Columns.Count) _
.End(xlToLeft)).Copy Destination:=NewWSheet.Range("A1")
'Else ' worksheet exists; do nothing
End If

' Copy

Set srg = internal_numberName.Offset(0, -3).Resize(1, 10)
Set dfCell = NewWSheet.Cells(NewWSheet.Rows.Count, "A") _
.End(xlUp).Offset(1, 0)

srg.Copy dfCell

End Sub