將excel中的多個不同選擇的數據從一個工作簿複製到另一個VBA

Question

我在弄清楚如何將數據從一個excel工作簿複製到另一個工作簿。最終目標是自動創建登錄表單 - 我在一個工作簿中擁有關於學生的信息，並且我想創建一個新的工作簿，該工作簿將以不同的順序顯示相關的列。我試圖找出如何使用各種方法從一張紙複製到另一張，但我不斷收到錯誤信息。下面是我使用的代碼：

Option Explicit 
Sub signinsheet() 
Dim newbook As Workbook 
Dim ldate As Date 
Dim center As Variant 
Dim title As Variant 
Dim original As Variant 
Dim pastebook As Workbook 
Dim students As Integer 
Dim wbTarget   As Workbook 'workbook where the data is to be pasted 
Dim wbThis    As Workbook 'workbook from where the data is to copied 


original = ActiveWorkbook.Name 



center = InputBox("What is the center name?") 
students = InputBox("How many students?") 

ldate = Date 
Set pastebook = Workbooks.Add 
    With pastebook 
     .title = center & ldate 
     .Subject = "signup sheet" 
     .SaveAs Filename:=center & ldate 
    End With 

title = center & ldate 



Workbooks(original).Activate 

Workbooks.Open (title) 

Workbooks(title).ActiveSheet.Range("F5", Range("F5").Offset(students, 0)).Value = Workbooks(original).Sheets("Sheet1").Range("B2", Range("B2").Offset(students, 0)).Value 

    'set to the current active workbook (the source book) 
Set wbThis = ActiveWorkbook 


    Set wbTarget = Workbooks.Open(title) 

wbTarget.Sheets("sheet1").Range("F5").Select 

'activate the source book 
    wbThis.Activate 

    'clear any thing on clipboard to maximize available memory 
    Application.CutCopyMode = False 

    'copy the range from source book 
    wbThis.Sheets("sheet1").Range("B2", Range("B2").Offset(students, 0)).Copy 

    'paste the data on the target book 
    wbTarget.Sheets("sheet1").Range("F5").PasteSpecial 

    'clear any thing on clipboard to maximize available memory 
    Application.CutCopyMode = False 

    'save the target book 
    wbTarget.Save 

    'close the workbook 
    wbTarget.Close 

    'activate the source book again 
    wbThis.Activate 

    'set to the current active workbook (the source book) 
    Set wbThis = ActiveWorkbook 

    'open a workbook that has same name as the sheet name 
    Set wbTarget = Workbooks.Open(title) 

    wbTarget.Sheets("sheet1").Range("A5").Select 

    'activate the source book 
    wbThis.Activate 

    'clear any thing on clipboard to maximize available memory 
    Application.CutCopyMode = False 

    'copy the range from source book 
    wbThis.Sheets("sheet1").Range("C2", Range("C2").Offset(students, 0)).Copy 

    'paste the data on the target book 
    wbTarget.Sheets("sheet1").Range("F5").PasteSpecial 

    'clear any thing on clipboard to maximize available memory 
    Application.CutCopyMode = False 

    'save the target book 
    wbTarget.Save 

    'close the workbook 
    wbTarget.Close 

    'activate the source book again 
    wbThis.Activate 

    'set to the current active workbook (the source book) 
    Set wbThis = ActiveWorkbook 

    'open a workbook that has same name as the sheet name 
    Set wbTarget = Workbooks.Open(title) 

    wbTarget.Sheets("sheet1").Range("B5").Select 

    'activate the source book 
    wbThis.Activate 

    'clear any thing on clipboard to maximize available memory 
    Application.CutCopyMode = False 

    'copy the range from source book 
    wbThis.Sheets("sheet1").Range("D2", Range("D2").Offset(students, 0)).Copy 

    'paste the data on the target book 
    wbTarget.Sheets("sheet1").Range("F5").PasteSpecial 

    'clear any thing on clipboard to maximize available memory 
    Application.CutCopyMode = False 

    'save the target book 
    wbTarget.Save 

    'close the workbook 
    wbTarget.Close 

    'activate the source book again 
    wbThis.Activate 


End Sub 

基本上我想B2從原始工作簿複製到學生人數至F5就倒在新的工作簿。我也希望C2下來去A5，我想D2下來去B5。偶爾會在第一次複製時工作，但之後會中斷並停止工作。 （我使用的是一個mac，現在指的是工作簿，因爲工作簿（原始）或工作簿（標題）適用於我。標題是新工作簿的名稱。我有一些其他的格式片，但我從代碼中刪除它，保持機密性（因爲它的工作）

Answer 1

我相信你會對下面的代碼錯誤。

1）你不關閉工作簿保存後，使無需打開它再次

Set pastebook = Workbooks.Add 
    With pastebook 
     .title = center & ldate 
     .Subject = "signup sheet" 
     .SaveAs Filename:=center & ldate 
    End With 

title = center & ldate 

Workbooks(original).Activate 

Workbooks.Open (title) 'The title workbook is still open 
'beside to open a workbook need full file path, title is only file name 

2）錯誤使用ActiveSheet的

Workbooks(title).ActiveSheet.Range("F5", Range("F5").Offset(students, 0)).Value = ..... 

因爲你打電話給Workbooks(title).ActiveSheet，這是錯誤的。

---

對不起，這不是一個直接的答案，但你應該能夠解決這個問題。如果您按照最佳實踐遵循以下方法。

下面的方法，你不會有任何錯誤，即使你不激活（wbThis.Activate）的工作簿或工作，而你嘗試複製&粘貼

1）設置工作簿或工作變量

'Set Worksheet you need to variable 
Set pastebook = Workbooks.Add 
Set pastesheet = pastebook.sheets("PastToSheetName") 

set wsThis = wbThis.sheets("CopyFromSheetName") 

2）參考時要複製粘貼&

wsThis.Range("B2", Range("B2").Offset(students, 0)).Copy pastesheet.Range("F5")