Vba 将行转换为图纸所需的宏

我正在搜索一个宏，以获取一个包含多行的excel文件，并将工作表的行拆分为每个工作表所需的任意行数的工作表，包括原始行，这些行也应复制到每个工作表中。 简单来说，如果我有一个包含行的文件

1
2
3

然后，宏分割行，用.csv文件制作一张表，这样我们就得到了上面的3文件表单

file1   file2   file3
  1         1       1
            2       2
                    3 

我希望你明白我的意思 我找过了，但只找到了

Option Explicit

Sub SplitWorkbooksByNrows()
'Jerry Beaucaire,  2/28/2012
'Split all data sheets in a folder by a variable number or rows per sheet, optional titles
'assumes only one worksheet of data per workbook
Dim N As Long, rw As Long, LR As Long, Cnt As Long, Cols As String, Titles As Boolean
Dim srcPATH As String, destPATH As String, fNAME As String, wbDATA As Workbook, titleRNG As Range

srcPATH = "C:\Path\To\Source\Files\"            'remember the final \ in this string
destPATH = "C:\Path\To\Save\NewFiles\"          'remember the final \ in this string
                                                'determine how many rows per sheet to create
    N = Application.InputBox("How many rows per sheet?", "N-Rows", 50, Type:=1)
    If N = 0 Then Exit Sub                      'exit if user clicks CANCEL
                                                'Examples of usable ranges:  A:A    A:Z   C:E   F:F
    Cols = Application.InputBox("Enter the Range of columns to copy", "Columns", "A:Z", Type:=2)
    If Cols = "False" Then Exit Sub             'exit if user clicks CANCEL
                                                'prompt to repeat row1 titles on each created sheet
    If MsgBox("Include the title row1 on each new sheet?", vbYesNo, _
                "Titles?") = vbYes Then Titles = True

    Application.ScreenUpdating = False          'speed up macro execution
    Application.DisplayAlerts = False           'turn off system alert messages, use default answers
    fNAME = Dir(srcPATH & "*.xlsx")             'get first filename from srcPATH

    Do While Len(fNAME) > 0                     'exit loop when no more files found
        Set wbDATA = Workbooks.Open(srcPATH & fNAME)        'open found file
        With ActiveSheet
            LR = Intersect(.Range(Cols), .UsedRange).Rows.Count             'how many rows of data?
            If Titles Then Set titleRNG = Intersect(.Range(Cols), .Rows(1)) 'set title range, opt.
            For rw = 1 + ---Titles To LR Step N 'loop in groups of N rows
                Cnt = Cnt + 1                   'increment the sheet creation counter
                Sheets.Add                      'create the new sheet
                If Titles Then titleRNG.Copy Range("A1")    'optionally add the titles
                                                'copy N rows of data to new sheet
                Intersect(.Range("A" & rw).Resize(N).EntireRow, .Range(Cols)).Copy Range("A1").Offset(Titles)
                ActiveSheet.Columns.AutoFit     'cleanup
                ActiveSheet.Move                'move created sheet to new workbook
                                                'save with incremented filename in the destPATH
                ActiveWorkbook.SaveAs destPATH & "Datafile_" & Format(Cnt, "00000") & ".xlsx", xlNormal
                ActiveWorkbook.Close False      'close the created workbook
            Next rw                             'repeat with next set of rows
        End With
        wbDATA.Close False                      'close source data workbook

        fNAME = Dir                             'get next filename from the srcPATH
    Loop                                        'repeat for each found file

    Application.ScreenUpdating = True           'return to normal speed
    MsgBox "A total of " & Cnt & " data files were created."        'report
End Sub

参考文献 这个宏正在做什么

if we have these rows
    1
    2
    3

宏执行此操作

file1   file2   file3
  1         2       3   

提供的代码完全符合我的要求，但前提是宏可以将行添加到。像这样

file1   file2   file3
  1         1       1
            2       2
                    3 

---

这可能会帮助你开始。您需要放置自己的范围引用和文件路径等

Sub SplitAndSave()
    Dim rows As Long, rw As Long, myFolder As String, ws As Worksheet

    rows = Worksheets("Sheet1").Range("A1:A10").rows.Count
    myFolder = "C:\Users\Desktop\MyFolder\"
    Set ws = Worksheets("Sheet2")

    For rw = 1 To rows
        ws.Cells.ClearContents
        Range("A1:A" & rw).Copy Destination:=ws.Range("A1")
        ws.SaveAs myFolder & "file" & rw & ".csv", xlCSV
    Next rw
End Sub

---

这将把

范围（A1:A10）

中的数据拆分为十个独立的

.csv

文件，并将它们放在桌面上名为

MyFolder

的文件夹中。

尝试使用宏记录器了解所需代码的大致情况。到目前为止，很难理解您需要什么，而且您似乎没有尝试编写任何代码……询问代码的问题必须表明您对正在解决的问题的最低理解。包括尝试过的解决方案、它们不起作用的原因以及预期结果。另请参见：花点时间，将您的问题（和上面的评论）编辑成可理解的英语。我担心你会被拒之门外。好的，为了更好地理解这个问题，我们添加了更多的细节。我想我的要求现在就清楚了。ThanksMacro告诉你，如果我们有5个栏目，你会比我们将如何做更震撼。对于5个栏目，请更改为

范围（“A1:E”&rw）。复制…