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

时间:2013-09-04 15:51:57

标签: excel vba excel-vba

我正在撕扯我的头发试图做一个非常简单的微调调整。

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

我要做的就是复制原始工作簿中原始活动表中的所有单元格内容(将是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

可以告诉我如何解决这个问题吗?

任何帮助表示感谢。

3 个答案:

答案 0 :(得分:2)

你可以这样做:

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

仅供参考,如果您在执行您想要编码的操作时在Excel中记录宏,您通常可以通过对自动生成的宏代码进行最少的修改来获得您正在寻找的内容。

答案 1 :(得分:2)

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

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

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

答案 2 :(得分:0)

您会考虑整体复制工作表吗?这是一个基本示例,您必须自定义工作簿组织和命名要求。

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