在excel VBA中将多个不同的数据选择从一个工作簿复制到另一个工作簿

时间:2016-07-22 18:43:16

标签: excel vba excel-vba

我正在试图弄清楚如何将数据从一个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,现在指的是工作簿,因为工作簿(原始)或工作簿(标题)对我有用。标题是新工作簿的名称。我在登录时有一些其他的格式表格,但我已从代码中删除它以保持机密性(并且因为它正在工作)。

1 个答案:

答案 0 :(得分:0)

我相信您会在以下代码中出错:

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,这是错误的。

对不起,这不是一个直接的答案,但你应该能够解决它。如果您遵循以下方法作为最佳做法。

使用以下方法,即使您在尝试复制&amp ;;时未激活(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")