如何将工作表从一个工作簿复制到另一个工作簿?

时间:2018-08-01 06:34:10

标签: excel vba excel-vba

我是VBA的新手,它使用宏根据某些条件将工作簿拆分为多个文件,然后根据其他条件将其再次拆分为多个工作表。

将最终文件拆分为多个工作表后,我想将工作表从主文件复制到每个目标文件,并且此复制的工作表应位于新文件中所有其他新创建工作表的末尾。

我的代码在我要复制该工作表的行中有问题。如果我不尝试在代码末尾复制该工作表,则一切正常,并且我将许多目标文件拆分为多个工作表。如果我尝试添加一行代码来复制需要按原样复制的工作表,那么我只会得到一个目标文件(第一次拆分),并且该行出现了代码错误。

这是执行此操作的全部代码:

Sub Split()

Dim wswb As String
Dim wssh As String

wswb = ActiveWorkbook.Name
wssh = ActiveSheet.Name

vColumn = InputBox("Please indicate which column you would like to split by", "Column selection")

Columns(vColumn).Copy
Sheets.Add
ActiveSheet.Name = "_Summary"
Range("A1").PasteSpecial
Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes

vCounter = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To vCounter
    vFilter = Sheets("_Summary").Cells(i, 1)
    Sheets(wssh).Activate
    ActiveSheet.Columns.AutoFilter field:=6, Criteria1:="100%"
    ActiveSheet.Columns.AutoFilter field:=Columns(vColumn).Column, Criteria1:=vFilter
    Cells.Copy
    Workbooks.Add
    Range("A1").PasteSpecial

    ActiveSheet.Name = "Master"


    dspColumn = "D"


    Columns(dspColumn).Copy
    Sheets.Add
    ActiveSheet.Name = "dspSummary"
    Range("A1").PasteSpecial
    Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes

    dspCounter = Range("A" & Rows.Count).End(xlUp).Row
    Splitcode = Range("A" & Rows.Count).End(xlUp).Row

    For j = 2 To dspCounter
        dspFilter = Sheets("dspSummary").Cells(j, 1)
        Sheets("Master").Activate
        ActiveSheet.Columns.AutoFilter field:=Columns(dspColumn).Column, Criteria1:=dspFilter
        Cells.Copy
        Sheets.Add
        ActiveSheet.Name = Left(dspFilter, 30)

        Range("A1").PasteSpecial
    Next j
    Sheets("Master").Delete
    Sheets("dspSummary").Delete

    If vFilter <> "" Then
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Split Results\" & vFilter
    Else
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Split Results\_Empty"
    End If


    ActiveWorkbook.Close
    Workbooks(wswb).Activate
    Sheets("Reasons codes").Copy After:=Workbooks(ThisWorkbook.Path & "\Split Results\" & vFilter & ".xlsx").Sheets(Sheets.Count)
Next i
Sheets("_Summary").Delete

End Sub
Sub SplitM()

End Sub

出现问题的行是此行:

Sheets("Reasons codes").Copy After:=Workbooks(ThisWorkbook.Path & "\Split Results\" & vFilter & ".xlsx").Sheets(Sheets.Count)

没有它,一切正常,并且没有错误。添加该行后,仅创建了一个文件,而我想在循环末尾复制的工作表当然也不会被复制,并且在该行出现了一个错误。

我实际上要在那行之前做的是获取主工作簿,将其激活,然后从其中复制一个名为“ Reasons code”的工作表到我创建的每个分割文件中(也从目标文件中用循环拆分)在该目标文件中创建。

顺便说一句,主(原始)文件中的“ G”列以及我要从中拆分的原始工作表具有一些数据验证,这些数据已链接到我要复制的工作表“原因代码”。因此,如果您也有解决方案,那么在将“ Reasons code”表复制到每个目标文件之后,如何在新文件的新表中链接该列,那真是太好了!实际上,新文件(分割的文件/目标文件)中的每个分割工作表在“ G”列中的内容也与我要复制的主文件中的主要工作表相同。现在只是粘贴文本,但是当我查看数据验证时,我发现它链接到主文件名以及主文件的“ Reasons代码”,这就是验证不起作用的原因。每一行都应该链接到同一文件中新创建的“原因代码”表。

0 个答案:

没有答案