Как я могу объединить эти два примера кода - разделение книги Excel и удаление речевых меток из CSV

Question

Во-первых, очень жаль, я очень плохо знаком с vba и знаю, что это будет очень простой вопрос для многих здесь, но я пытаюсь учиться.

Я пытаюсь разбить файл Excel на отдельные CSV-файлы на основе первого блока кода, который я взял с этого сайта.

Я также пытаюсь запустить второй блок кода где-то в первом блоке, чтобы открыть файлы CSV и удалить "", который он вставляет туда.

Обе части кода работают по отдельности, но у меня нет знаний или навыков, чтобы объединить их вместе. Я пытался в течение дня, но биты вроде:

wb.SaveAs ThisWorkbook.Path & "\" & Prefix & "_" & WorkbookCounter

В первом блоке кода и пытаемся заменить его следующим:

xName = Application.GetSaveAsFilename("C:\Users\trd836c3\Desktop\PO creation files\Files for upload testing\" & "Purchase" & Format(Now(), "yyyymmddhhmmss"), "CSV File (*.csv), *.csv")

или любая их комбинация просто не работают.

Это код для разделения файла Excel с LuH, но он сохраняется как файл Excel, и я не могу понять, как изменить его на csv с именем файла YYYYMMDDHHMMSS.

Sub Test()
  Dim wb As Workbook
  Dim ThisSheet As Worksheet
  Dim NumOfColumns As Integer
  Dim RangeToCopy As Range
  Dim WorkbookCounter As Integer
  Dim RowsInFile
  Dim Prefix As String

  Application.ScreenUpdating = False

  'Initialize data
  Set ThisSheet = ThisWorkbook.ActiveSheet
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 100     'how many rows (incl. header) in new files?
  Prefix = "test"      

  For p = 1 To ThisSheet.UsedRange.Rows.Count Step RowsInFile
  Set wb = Workbooks.Add

 'Paste the chunk of rows for this file
 Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1),ThisSheet.Cells(p + RowsInFile - 1, NumOfColumns))
 RangeToCopy.Copy wb.Sheets(1).Range("A1")

'Save the new workbook, and close it
 wb.SaveAs ThisWorkbook.Path & "\" & Prefix & "_" & WorkbookCounter
 wb.Close

'Increment file counter
 WorkbookCounter = WorkbookCounter + 1
 Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub

Этот код создает файл csv с именем рабочего файла и удаляет речевые метки, но я не могу заставить его автоматически разбивать файл excel на отдельные файлы csv из 10 строк.

Sub Export()
'updateby Extendoffice 20160530
Dim xRg As Range
Dim xRow As Range
Dim xCell As Range
Dim xStr As String
Dim xTxt As String
Dim xName As Variant
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
  xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
  xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("Please select data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xName = Application.GetSaveAsFilename("C:\Users\trd836c3\Desktop\PO creation files\Files for upload testing\" & "Purchase" & Format(Now(), "yyyymmddhhmmss"), "CSV File (*.csv), *.csv")
Open xName For Output As #1
For Each xRow In xRg.Rows
    xStr = ""
    For Each xCell In xRow.Cells
        xStr = xStr & xCell.Value & Chr(9)
    Next
    While Right(xStr, 1) = Chr(9)
        xStr = Left(xStr, Len(xStr) - 1)
    Wend
    Print #1, xStr
Next
Close #1
If Err = 0 Then MsgBox "The file has saved to: " & xName, vbInformation,      "Kutools for Excel"
End Sub

Answer 1

Если я правильно понял ваше требование, приведенный ниже код даст вам результат

Sub Test()

Dim wb As Workbook
Dim ThisSheet As Worksheet
Dim NumOfColumns As Integer
Dim RangeToCopy As Range
Dim WorkbookCounter As Integer
Dim RowsInFile
Dim Prefix As String

Application.ScreenUpdating = False

'Initialize data
Set ThisSheet = ThisWorkbook.ActiveSheet
NumOfColumns = ThisSheet.UsedRange.Columns.Count
WorkbookCounter = 1
RowsInFile = 100     'how many rows (incl. header) in new files?
Prefix = "test"

For p = 1 To ThisSheet.UsedRange.Rows.Count Step RowsInFile

    'Paste the chunk of rows for this file
    Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + 
RowsInFile - 1, NumOfColumns))

    xName = ThisWorkbook.Path & "\" & Prefix & "_" & WorkbookCounter & ".csv"
    Open xName For Output As #1
    For Each xRow In RangeToCopy.Rows
        xStr = ""
        For Each xCell In xRow.Cells
            xStr = xStr & xCell.Value & Chr(9)
        Next
        While Right(xStr, 1) = Chr(9)
            xStr = Left(xStr, Len(xStr) - 1)
        Wend
        Print #1, xStr
    Next
    Close #1

    'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
Next p

Application.ScreenUpdating = True
Set wb = Nothing

End Sub