VBA：清除剪贴板并在每个循环中重新填充

问：

设置

我的源 Excel 文件有 10k 行，每行 32 列。我需要将其分解为 10 个文件，每个文件为 1k，并提取一个特定的列 AD 以供进一步处理。

列 AD 是一个文本字符串，其中包含我需要保留的特殊字符，我正在尝试从过滤的字符串中删除不需要的双引号，以便稍后粘贴到另一个应用程序中。

问题陈述

只有第一个文件正确保存。第二个文件重复第一个循环中的信息，并使用第二个循环中过滤的行对其进行更新，第三个文件包含来自第一个、第二个和第三个循环等的数据。也就是说，当我们到达第 10 个文件时，我有 10k 行而不是 1k

问题

如何在循环之间清除剪贴板，以便清空 DataArray 和剪贴板，并用该特定循环的过滤文本重新填充？

我的（经过解释编辑）VBA是：

Sub SaveFiles()

'Declarations

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("SourceData")
Dim Insert As Long, Max_Ins As Long, i As Long
Dim DataArr() As Variant
Dim objData As New DataObject
Dim concat As String, cellValue As String


'begin filtering Source Data Sheet to target required rows
Max_Ins = Application.WorksheetFunction.Max(ws.Range("AF:AF"))
ActiveSheet.Range("A:AF").AutoFilter Field:=27, Criteria1:="Ins"
    
For Insert = 1 To Max_Ins
           ' "Insert" is a cell on the Source Sheet which assigns rows 2 to 1000 as 1, 1001 to 2000 as 2 etc.
            ActiveSheet.Range("$AF:$AF").AutoFilter Field:=32, Criteria1:=Insert
           ' I only need to process column AD for this exercise
            Range("AD1").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy

' I need the data in a new workbook
    Workbooks.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:1").Select
    Application.CutCopyMode = False
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select

'now I have my 'mini file' created I want to load the data into an array for processing.
Erase DataArr
DataArr = Selection

' I found this in another post, and it's successfully removing the double quotes from the data so I can then copy/paste it correctly later.
        For i = LBound(DataArr, 1) To UBound(DataArr, 1)
                         If IsNumeric(DataArr(i, 1)) Then
                            cellValue = LTrim(Str(DataArr(i, 1)))
                        Else
                            cellValue = DataArr(i, 1)
                        End If
                        
                        concat = concat + CR + cellValue
                        CR = Chr(13)
                        objData.SetText (Mid(concat, 3))
                        objData.PutInClipboard
        Next i
        
'Now my text is as I need it, i'm trying to paste it back into the workbook.
'I start by removing the existing data (which is now in the array, and has been cleansed)
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
'then paste back the objData cleansed values
    Range("A1").Select
    ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
    DisplayAsIcon:=False, NoHTMLFormatting:=True
    
'I don't need the header row in my final files but it seems good to have it processed as, without it, the first line is usually 3 chara
    Range("A1").Select
    Selection.Delete Shift:=xlUp
    
'Attempting to clear the Clipboard in objdata ready for the next loop.
'This is the part which I need help with as it's not working and so the 2nd loop retains the data from the first loop and then adds the 2nd, the 3rd contains 1,2 and then adds 3 etc.
objData.SetText Text:=Empty
objData.PutInClipboard
    
'saving down the files
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\...\" & Format(Date, "YYYYMMDD") & "_" & Format(Time, "hhmmss") & "Insert" & "_" & Insert & ".xlsx" _
          , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close

Next

MsgBox ("Files saved")

End Sub