Vba 根据另一列中的条件拆分excel中的列

下面是我的代码；我尝试将列的代码数据拆分为不同的表。 我的问题是,；我需要输入一个新条件，以从列中获取订单；在这里，我每次存储1-50000个特定值范围内的数字，并生成最终图纸

例如：我希望工作表“101”“102”“501”中包含来自列“Orders”的数据，仅包含值=>

0和IsNumeric（CN））的数据，然后
MsgBox“输入无效，代码中止”，vbCritical
出口接头
如果结束
'3-将用户输入存储在'CN'变量中
将HKFrom设置为整数
HKFrom=InputBox（“请从以下位置插入订单：”，“收集用户输入”）
'在继续验证输入之前测试输入
如果不是（Len（HKFrom）>0和IsNumeric（HKFrom）），则
MsgBox“输入无效，代码中止”，vbCritical
出口接头
如果结束
'4-将用户输入存储在'CN'变量中
将HKTILL设置为整数
HKTILL=InputBox（“请插入订单，最多：”，“收集用户输入”）
'在继续验证输入之前测试输入
如果不是（Len（hkintil）>0且为数字（hkintil）），则
MsgBox“输入无效，代码中止”，vbCritical
出口接头
如果结束
vCol=CN
设置ws=Sheets（Fullo）
'点底行数据
LR=ws.Cells（ws.Rows.Count，vCol）.End（xlUp）.Row
'标题跨越数据顶部的范围，如字符串，数据必须
'如果此行中有标题，请编辑以适合您的标题区域设置
title=“A1:H1”
titlerow=ws.Range（title）.Cells（1）.Row
icol=ws.Columns.Count
ws.Cells（1，icol）=“唯一”
对于i=2至LR
出错时继续下一步
如果ws.Cells（i，vCol）“”和Application.WorksheetFunction.Match（ws.Cells（i，vCol），ws.Columns（icol），0）=0，则
ws.Cells（ws.Rows.Count，icol）.End（xlUp）.Offset（1）=ws.Cells（i，vCol）
如果结束
'错误处理
下一个
MyArr=Application.WorksheetFunction.Transpose（ws.Columns（icol）.SpecialCells（xlCellTypeConstants））
ws.Columns（icol）.清除
对于i=2至UBound（MyArr）
ws.Range（title）.AutoFilter字段：=vCol，标准1:=MyArr（i）&“”
如果不进行评估（“=ISREF（”&MyArr（i）&“！A1）”），则
Sheets.Add（之后：=工作表（Worksheets.Count））.Name=MyArr（i）和“”
其他的
工作表（MyArr（i）和“”）。移动后：=工作表（Worksheets.Count）
如果结束
ws.Range（“A”&标题栏&“：A”&标题栏）.EntireRow.Copy图纸（MyArr（i）&“）.Range（“A1”）
图纸（MyArr（i）和“”）.Columns.AutoFit
下一个
ws.AutoFilterMode=False
ws.Activate
端接头

请添加带有图片的示例。你的描述太模糊了。@ Luuklag有一个图片在“数据”链接，请考虑提供一个。如果你能减少我们需要阅读的代码量，你就更有可能得到一个有效的答案。嗨，伙计们，有什么想法吗？！

The "value" to be populated by the user=> "Please Insert Orders from"=> 0 
                                          "Please Insert Orders up to"=>50 

Private Sub Run_Click()

Dim LR As Long
Dim ws As Worksheet
Dim vCol, i, j As Integer
Dim icol As Long
Dim MyArr As Variant
Dim title As String
Dim titlerow As Integer



'1-store user input in 'Fullo' variable
Dim Fullo As String
Fullo = InputBox("Please insert sheet of analysis:", "Collect User Input")

'test input before continuing to validate the input
If Not (Len(Fullo) > 0) Then
    MsgBox "Input not valid, code aborted.", vbCritical
    Exit Sub
End If

'2-store user input in 'CN' variable
Dim CN As Integer
CN = InputBox("Please insert column of analysis:", "Collect User Input")

'test input before continuing to validate the input
If Not (Len(CN) > 0 And IsNumeric(CN)) Then
    MsgBox "Input not valid, code aborted.", vbCritical
    Exit Sub
End If

'3-store user input in 'CN' variable
Dim HKFrom As Integer
HKFrom = InputBox("Please insert Orders from:", "Collect User Input")

'test input before continuing to validate the input
If Not (Len(HKFrom) > 0 And IsNumeric(HKFrom)) Then
    MsgBox "Input not valid, code aborted.", vbCritical
    Exit Sub
End If

'4-store user input in 'CN' variable
Dim HKUntil As Integer
HKUntil = InputBox("Please insert Orders up to:", "Collect User Input")

'test input before continuing to validate the input
If Not (Len(HKUntil) > 0 And IsNumeric(HKUntil)) Then
    MsgBox "Input not valid, code aborted.", vbCritical
    Exit Sub
End If


vCol = CN
Set ws = Sheets(Fullo)
'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
title = "A1:H1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"


For i = 2 To LR
On Error Resume Next
If ws.Cells(i, vCol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vCol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vCol)
End If

'error handling
Next
MyArr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear


For i = 2 To UBound(MyArr)
ws.Range(title).AutoFilter Field:=vCol, Criteria1:=MyArr(i) & ""
If Not Evaluate("=ISREF('" & MyArr(i) & "'!A1)") Then
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i) & ""
Else
Sheets(MyArr(i) & "").Move After:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & LR).EntireRow.Copy Sheets(MyArr(i) & "").Range("A1")
Sheets(MyArr(i) & "").Columns.AutoFit

Next
ws.AutoFilterMode = False
ws.Activate

End Sub