未找到订阅，正在创建一个具有排序变量VBA的新工作表

Question

当我运行下面的代码时，我遇到了一个错误，错误指出"订阅超出范围"。当我调试时，它跳转到"Set WSNew = wsmain . worksheets ("sheetName") '设置WSNEW为新的sheetName"线。

代码确实创建了一个新的工作表，但它是空的，而它应该携带在for循环中提到的WSNew值。

请看下面的代码:

Option Explicit
Public WBMAIN As Workbook
Public WSmain As Worksheet
Public WSvl As Worksheet
Public WSNew As Worksheet
Sub Main()
Dim OBdate As String, amount As String, yesno As String, yesno2 As String ' All Variables
Dim OLDr As Long, OLDc As Long, NEWr As Long, NEWc As Long, sheetName As String
Dim VLookupResult As String, complexName As String
Dim FilePath As String
OLDc = 2  ' First Sheet Column
NEWr = 1  ' New Sheet Row
NEWc = 1  ' New Sheet Column
FilePath = ThisWorkbook.path ' File path for this workbook
Set WBMAIN = Workbooks("EVO_MOD") ' set WBMAIN to the entire workbook
Set WSmain = WBMAIN.Worksheets("EVO MOD FORM") ' set WSmain to the first worksheet
Set WSvl = WBMAIN.Worksheets("Vlookup") ' set the Vlookup for the acc no.

complexName = WSmain.Cells(2, 2) ' Complex Name Cell
OBdate = WSmain.Cells(1, 2) ' Date Cell
WBMAIN.Activate ' Activates WBmain
sheetName = "EVO_" + complexName ' Sheet Name
Sheets.Add.Name = sheetName
Set WSNew = WBMAIN.Worksheets(sheetName) ' Set WSNEW to the new sheetName
For OLDr = 13 To 200 ' for 200 lines in the main sheet
If WSmain.Cells(OLDr, OLDc) = 0 Then GoTo exitthis
If WSmain.Cells(OLDr, OLDc) <> 0 Then
VLookupResult = Application.VLookup(WSmain.Cells(OLDr, OLDc), WSvl.Range("A2:B200"), 2, False)
'Collect amount and detirmine if debit or credit
If WSmain.Cells(OLDr, 4) <> " " Then
amount = WSmain.Cells(OLDr, 4) ' If Credit is Empty do
yesno = "Y"
yesno2 = "N"
Else
If WSmain.Cells(OLDr, 5) <> " " Then ' if Debit is empty , do
amount = WSmain.Cells(OLDr, 5)
yesno = "N"
yesno2 = "Y"
Else
If WSmain.Cells(OLDr, 5) = " " & WSmain.Cells(OLDr, 4) = " " Then GoTo exitthis ' if both cells are blank , skip to exitthis
End If

WSNew.Cells(NEWr, 1) = OBdate                   ' Assigning 2 lines of code that prints to WSNew
WSNew.Cells(NEWr, 2) = "OB " + OBdate
WSNew.Cells(NEWr, 3) = "OB " + OBdate
WSNew.Cells(NEWr, 4) = amount
WSNew.Cells(NEWr, 5) = "N"
WSNew.Cells(NEWr, 8) = "0"
WSNew.Cells(NEWr, 10) = VLookupResult
WSNew.Cells(NEWr, 11) = yesno

NEWr = NEWr + 1

WSNew.Cells(NEWr, 1) = OBdate
WSNew.Cells(NEWr, 2) = "OB " + OBdate
WSNew.Cells(NEWr, 3) = "OB"
WSNew.Cells(NEWr, 4) = amount
WSNew.Cells(NEWr, 5) = "N"
WSNew.Cells(NEWr, 8) = "0"
WSNew.Cells(NEWr, 10) = "9990>001"
WSNew.Cells(NEWr, 11) = yesno2
End If
End If
exitthis:
Next OLDr
' Start creating CSV
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Check if Directory exists
' Dim fso As New FileSystemObject
Dim path As String
Dim mycsvfilename As String
mycsvfilename = ThisWorkbook.path & "EvolutionCSV"

WBMAIN.Sheets("newSheet").Activate
ActiveSheet.Copy
Set WSNew = ActiveWorkbook
With WSNew
.SaveAs Filename:=mycsvfilename, FileFormat:=xlCSV, CreateBackup:=False
' .Close
End With
SetAttr mycsvfilename, vbReadOnly
WBMAIN.Sheets("CSVexport").Delete
WBMAIN.Worksheets("Actions").Activate
err:
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

请告知是否有人有解决这个问题的方法或知道为什么会发生这个问题

Answer 1

您通过用引号将sheetName作为字符串传递，因此您可以将其更改为:

Set WSNew = WBMAIN.Worksheets(sheetName)

或

您可以在添加WSNew时将其设置为新工作表，然后更改其名称，如:

Set WSNew = WBMAIN.Sheets.Add
WSNew.Name = sheetName

编辑:

For循环部分的代码块:

For OLDr = 13 To 200 ' for 200 lines in the main sheet
If WSmain.Cells(OLDr, OLDc) = 0 Then GoTo exitthis
If WSmain.Cells(OLDr, OLDc) <> 0 Then

VLookupResult = Application.VLookup(WSmain.Cells(OLDr, OLDc), WSvl.Range("A2:B200"), 2, False)
'Collect amount and detirmine if debit or credit
If WSmain.Cells(OLDr, 4) <> " " Then
amount = WSmain.Cells(OLDr, 4) ' If Credit is Empty do
yesno = "Y"
yesno2 = "N"
ElseIf WSmain.Cells(OLDr, 5) <> " " Then ' if Debit is empty , do
amount = WSmain.Cells(OLDr, 5)
yesno = "N"
yesno2 = "Y"
Else
GoTo exitthis ' if both cells are blank , skip to exitthis
End If

WSNew.Cells(NEWr, 1) = OBdate                   ' Assigning 2 lines of code that prints to WSNew
WSNew.Cells(NEWr, 2) = "OB " + OBdate
WSNew.Cells(NEWr, 3) = "OB " + OBdate
WSNew.Cells(NEWr, 4) = amount
WSNew.Cells(NEWr, 5) = "N"
WSNew.Cells(NEWr, 8) = "0"
WSNew.Cells(NEWr, 10) = VLookupResult
WSNew.Cells(NEWr, 11) = yesno

NEWr = NEWr + 1

WSNew.Cells(NEWr, 1) = OBdate
WSNew.Cells(NEWr, 2) = "OB " + OBdate
WSNew.Cells(NEWr, 3) = "OB"
WSNew.Cells(NEWr, 4) = amount
WSNew.Cells(NEWr, 5) = "N"
WSNew.Cells(NEWr, 8) = "0"
WSNew.Cells(NEWr, 10) = "9990>001"
WSNew.Cells(NEWr, 11) = yesno2
End If
exitthis:
Next OLDr