将当前工作表的内容复制到vba创build的工作表中

我把我的头发撕了出来,试图做一个对macros观的简单调整。

复制和粘贴似乎不起作用。 我得到一个属性不支持错误。

我所要做的就是复制原始工作簿中的所有单元格内容(将成为sName)并将其粘贴到新的工作簿工作表(rvname)

这是我现在的代码:(我需要它在Excel 2003和2007中工作)

Sub create_format_wb() 'This macro will create a new workbook 'Containing sheet1,(job plan) Original, (job plan) Revised, and 1 sheet for each task entered in the inputbox. Dim Newbook As Workbook Dim i As Integer Dim sName As String Dim umName As String Dim rvName As String Dim tBox As Integer Dim jobplannumber As String Dim oldwb As String line1: tBox = Application.InputBox(prompt:="Enter Number of Tasks", Type:=1) If tBox < 1 Then MsgBox "Must be at least 1" GoTo line1 Else sName = ActiveSheet.Name umName = (sName & " Original") rvName = (sName & " Revised") jobplannumber = sName Set Newbook = Workbooks.Add With Newbook .Title = sName .SaveAs Filename:=(sName & " .xls") .Application.SheetsInNewWorkbook = 1 .Sheets.Add(, After:=Sheets(Worksheets.Count)).Name = umName Worksheets(umName).Range("A1").Select With Worksheets(umName).QueryTables.Add(Connection:= _ "ODBC;DSN=MX7PROD;Description=MX7PROD;APP=Microsoft Office 2003;WSID=USOXP-93BPBP1;DATABASE=MX7PROD;Trusted_Connection=Yes" _ , Destination:=Range("A1")) .CommandText = Array( _ "SELECT jobplan_print.taskid, jobplan_print.description, jobplan_print.critical" & Chr(13) _ & "" & Chr(10) & "FROM MX7PROD.dbo.jobplan_print jobplan_print" & Chr(13) & "" & Chr(10) _ & "WHERE (jobplan_print.jpnum= '" & jobplannumber & "' )") .Name = "Query from MX7PROD" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .Refresh BackgroundQuery:=False End With .Worksheets(umName).UsedRange.Columns.AutoFit .Sheets.Add(, After:=Sheets(Worksheets.Count)).Name = rvName For i = 1 To tBox .Sheets.Add(, After:=Sheets(Worksheets.Count)).Name = ("Task " & i) Next i End With Worksheets(rvName).UsedRange.Columns.AutoFit End If End Sub 

可以somone走过我如何去做这个?

任何帮助赞赏。

你可以做这样的事情:

 Sub Copy() Workbooks("Book1").Worksheets("Sheet1").Cells.Copy Workbooks("Book2").Worksheets("Sheet1").Range("A1").Select Workbooks("Book2").Worksheets("Sheet1").Paste End Sub 

仅供参考,如果您在执行要编写的操作的同时在Excel中loggingmacros,则通常可以通过对自动生成的macros代码进行最小的修改来获得所需的内容。

将工作表的内容复制到另一个现有的工作表:

 wsDest.UsedRange.Clear 'Clear the contents of the destination sheet wsSource.UsedRange.Copy Destination:=wsDest.Range("A1") 

wsSourcewsDest分别是源和目标工作表。

你会考虑复制整个工作表吗? 这是一个基本的例子,你必须定制你的工作簿组织和命名要求。

 Sub CopyWkst() Dim wksCopyMe As Worksheet Set wksCopyMe = ThisWorkbook.Worksheets("Sheet1") wksCopyMe.Copy After:=ThisWorkbook.Sheets(Worksheets.Count) ThisWorkbook.ActiveSheet.Name = "I'm New!" End Sub