Question

我有一个包含一张表的主工作簿，我需要将其分成许多工作簿，每个工作簿都有一个工作表。

当“主”工作表中的行在列B中具有相同的内容时，将创建这些新创建的工作簿。

我需要将这些工作簿保存到同一个特定的本地目录中，文件名是B列和B列的内容。 “.csv”使文件成为CSV文件而不是XLSX文件。

这是我到目前为止所做的事情（其中很多来自本网站上另一个热门话题，我做了一些调整）。

Sub Splitter()
    Dim Master As Workbook
    Set Master = Workbooks("Master").Worksheets("Master") 'This declares the target worksheet.

    last = 1
    For i = 1 To 2000 'This defines the amount of rows
        If Range("B" & i) <> Range("B" & (i + 1)) Then
            Range("A" & last & ":F" & i).Copy 
            Set NewBook = Workbooks.Add
            NewBook.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues

            Rows(1).EntireRow.Insert Shift:=xlDown
            Range("A1").Value = "Header1"
            Range("B1").Value = "Header2"
            Range("C1").Value = "Header3"
            Range("D1").Value = "Header4"
            Range("E1").Value = "Header5"
            Range("F1").Value = "Header6"

            last = i + 1
            Master.Activate
        End If
    Next i
End Sub

此代码将使用“Master”工作簿中的单个工作表创建数百个（如果不是数千个）工作簿。

我在这里有几个问题：

此代码：
```
Rows(1).EntireRow.Insert Shift:=xlDown
Range("A1").Value = "Header1"
Range("B1").Value = "Header2"
Range("C1").Value = "Header3"
Range("D1").Value = "Header4"
Range("E1").Value = "Header5"
Range("F1").Value = "Header6"
```
似乎正在正确添加标题行，但它似乎正在复制电子表格的整个内容并将其粘贴到下一个可用行。然后它会覆盖第1行的内容。

示例：宏将以下行拉到新工作簿：
```
Bat 
Bat
Bat
```
当上面的代码部分运行时，最终产品是：
```
Header
Bat
Bat
Bat
Bat
Bat
```
它似乎在复制内容，然后粘贴第1行。
如前所述，第二个问题是新创建的工作簿/工作表不会自动保存（CSV）并关闭，我需要自己进入并关闭/保存它们。

它们似乎正在被正确创建（问题＃1中的问题除外）。它们只是打开了，我需要命名并保存所有这些。由于我确信会有很多新创建的工作簿，因此缺乏功能会让我的生活变得非常困难......

对此的任何帮助将不胜感激。我对此很新，但我很快就接受了。

我为这篇长篇文章道歉，我希望尽可能清楚，不要浪费读者的时间。

Answer 1

因为您仍在Range("A" & last & ":F" & i).Copy的CopyMode中，.Insert将再次插入复制的行。因此，在Application.CutCopyMode = False之前放置Rows(1).EntireRow.Insert以再次停止插入复制的行。

您需要Workbook.SaveAs Method和Workbook.Close Method来保存和关闭工作簿。

NewBook.SaveAs(FileName, FileFormat, Password, WriteResPassword, ReadOnlyRecommended, CreateBackup, AccessMode, ConflictResolution, AddToMru, TextCodepage, TextVisualLayout, Local)
NewBook.Close(SaveChanges, Filename, RouteWorkbook)

例如。这应该有效：

NewBook.SaveAs FileName:="C:\Temp\MyFileName.csv", FileFormat:=xlCSV
NewBook.Close SaveChanges:=False

您应该使用Rows()或Range()等工作表指定任何Master.Rows()和NewBook.Worksheets("Sheet1").Range()，以便明确哪个工作簿\工作表的范围/行是。那你就不需要Master.Activate

Answer 2

考虑这段代码。

Sub Splitter()
    Dim Master As Workbook
    Dim n As Integer
    Dim strFile As String

    Set Master = Workbooks("Master").Worksheets("Master") 'This declares the target worksheet.

    last = 1
    For i = 1 To 2000 'This defines the amount of rows
        If Range("B" & i) <> Range("B" & i + 1) Then
            strFile = ThisWorkbook.Path & "\" & Range("b" & i) & ".csv"
            TransToCSV strFile, Range("A" & last & ":F" & i)
            last = i + 1

        End If
    Next i
End Sub

Sub TransToCSV(myfile As String, rng As Range)

    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String, strHeader As String
    strHeader = "Header1,Header2,Header3,Header4,Header5,Header6" & vbCrLf
    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)

                vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
            vTxt(n) = Join(vR, ",")
    Next i
    strTxt = strHeader & Join(vTxt, vbCrLf)
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

在关闭之前将动态范围复制到新工作簿，添加标题并将新工作簿保存到本地目录

2 个答案: