複製excel後保存

Question

當我試圖從1工作簿複製到另一個工作簿時，我從Excel中隱約定義錯誤。這隻發生在原始工作表關閉後。

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click 
    Dim Month As String = comboMonth.Text() + "_" + comboYear.Text() 
    Dim di As New IO.DirectoryInfo("K:\SMT\Metrics\" + Month) 
    Dim diar1 As IO.FileInfo() = di.GetFiles() 
    Dim dra As IO.FileInfo 

    Label1.Text = "Displaying All Files in K:\SMT\Metrics\" + Month + "\" 
    For Each dra In diar1 
     ListBox1.Items.Add(dra) 
    Next 


    Dim n As Integer = ListBox1.Items.Count 'Counter for loop 
    Dim f As String 'name of document for opening and loop progress 
    Dim XL As Excel.Application 'just for opening master 
    Dim BK As Excel.Workbook 'just for opening master 
    Dim SHT As Excel.Worksheet 'just for opening master 
    Dim BK2 As Excel.Workbook 'just for opening spreadsheets 
    Dim SHT2 As Excel.Worksheet 'just for opening spreadsheets 
    Dim Name As String = comboMonth.Text() + "_" + comboYear.Text() 
    Dim Document As String = "K:\SMT\Metrics\" + Name + "\" + Name + "_Metrics.xlsx" 
    Dim Location As String = "K:\SMT\Metrics\" + Name 
    XL = CreateObject("Excel.Application") 
    XL.Visible = True 'Only true for troubleshooting 
    XL.UserControl = True 'Only true for troubleshooting 
    BK = XL.Workbooks.Add 'New Spreadsheet 
    SHT = BK.ActiveSheet 
    BK.Sheets("Sheet2").Delete() 'Format 
    BK.Sheets("Sheet3").Delete() 'Format 
    Dim d = Convert.ToChar(n + 65) 

    Do While n > 0 
     d = Convert.ToChar(n + 65) 
     ListBox1.SetSelected(n - 1, True) 'Highlite last item in list 
     f = ListBox1.SelectedItem.ToString() 'save the name of the file 
     BK2 = XL.Workbooks.Open("K:\SMT\Metrics\" + Month + "\" + f) 'Open the file highlited 
     SHT2 = BK2.ActiveSheet 'focus on opend sheet 
     SHT2.Copy(SHT) 'Copy focused sheet into "new" Spreadsheet 
     BK2.Close() 'kill 
     BK2 = Nothing 'kill 
     SHT = BK.ActiveSheet 'Focus on copied sheet 
     SHT.Name = f 'renamed focused sheet 
     SHT2 = BK.Sheets("Sheet1") 'Dim for the sheet being built The next long bit is the main report being built 
     SHT2.Cells(2, 1) = "Components Placed" 
     SHT2.Cells(3, 1) = "Good Placements" 
     SHT2.Cells(4, 1) = "False Call (Determined good)" 
     SHT2.Cells(5, 1) = "Bad Parts/Placements" 
     SHT2.Cells(6, 1) = "Pass Rate" 
     SHT2.Cells(6, n + 1) = "=(" + d + "3+" + d + "4)/(" + d + "2)" 
     'BK.Worksheets("Sheet1").Row(6).NumberFormat = "#.##%" 
     SHT2.Cells(1, n + 1) = f 
     SHT2.Cells(2, n + 1) = SHT.Cells(9, 44) 
     SHT2.Cells(3, n + 1) = SHT.Cells(11, 44) 
     SHT2.Cells(4, n + 1) = SHT.Cells(13, 44) 
     SHT2.Cells(5, n + 1) = SHT.Cells(15, 44) 
     ListBox1.Items.RemoveAt(n - 1) 'delete list item just process 
     ListBox2.Items.Add(f) 'write processed file in done list 
     n = ListBox1.Items.Count 'update count 'exit loop at 0 
    Loop 
    n = ListBox2.Items.Count 'get a good count for determining Math Column 
    d = Convert.ToChar(n + 65) 
    SHT2.Cells(1, n + 2) = "Total" 
    SHT2.Cells(2, n + 2) = "=SUM(B2:" + d + "2)" 
    SHT2.Cells(3, n + 2) = "=SUM(B3:" + d + "3)" 
    SHT2.Cells(4, n + 2) = "=SUM(B4:" + d + "4)" 
    SHT2.Cells(5, n + 2) = "=SUM(B5:" + d + "5)" 
    SHT2.Cells(6, n + 2) = "=(" + d + "3+" + d + "4)/(" + d + "2)" 

    SHT2 = Nothing 
    BK.Sheets("Sheet1").name = Name 'name blank page as the monthly report 
    SHT = BK.Sheets(Name) 'Because 
    SHT.Activate() 'leave the document on the finished report 
    BK.Worksheets(Name).Columns("A:ZZ").EntireColumn.AutoFit() 

    XL.Visible = True 
    XL.UserControl = True 

    'SHT.SaveAs(Document) 
    'SHT = Nothing 
    'BK = Nothing 
    'XL.Quit() 
    'XL = Nothing 
End Sub 

請幫我理解發生了什麼事。此外，代碼正在做我希望它做的一切。

Answer 1

作爲您的指導，這部分代碼將在打開的名爲BK2的工作簿中將SHT2複製到名爲工作表（稱爲Data1）之後的當前活動工作簿中，然後關閉打開的工作簿BK2。

Sub copySheet() 
Dim BK2 As Workbook 
Dim SHT2 As Worksheet 

Set BK2 = Workbooks.Open("C:\Data\VBA\SO\Test2.xlsx") 
Set SHT2 = BK2.ActiveSheet 
SHT2.Copy After:=Workbooks("Book1").Sheets("Data1") 
BK2.Close 
End Sub