2012-12-06 101 views
0

假设我在Excel中有Sheet(1)。现在我也有2500行,其中有从A到BO列的数据。现在我希望数据从这些表复制到另一张相同的Excel文件的2500行,但不是整个列,而只需要从A到AA数据的列将复制到新工作表。如何使用vbscript将一张纸的行复制到另一张纸上

那么如何使用VBscript框架?

请帮帮我。

如何行使用VBScript

+0

这也是非常有用 - http://stackoverflow.com/questions/10106465/excel-column-number-from-column-name –

回答

3

复制数据从一个表复制从一个表到另一个表到另一个你可以使用复制EN PasteSpecial的命令。如果你想用VBS宏,你也可以拨打复制和粘贴的方法来做到这一点在Excel

' Create Excel object 
Set objExcel = CreateObject("Excel.Application") 
' Open the workbook 
Set objWorkbook = objExcel.Workbooks.Open _ 
    ("C:\myworkbook.xlsx") 
' Set to True or False, whatever you like 
objExcel.Visible = True 

' Select the range on Sheet1 you want to copy 
objWorkbook.Worksheets("Sheet1").Range("A1:AA25").Copy 
' Paste it on Sheet2, starting at A1 
objWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial 
' Activate Sheet2 so you can see it actually pasted the data 
objWorkbook.Worksheets("Sheet2").Activate 

:要与.vbs脚本执行以下操作做到这一点。只有你的工作簿对象将会像ActiveWorkbook

0
Sub buildMissingSheet(strMissingSheet) 'Just passing the missing sheet name in 

' Master Sheet code 
' Working on creating the "Master Sheet" at this time...May need to seperate the the code a little. 
Dim GetRows1 As Worksheet 
Dim GetRows2 As Worksheet 
Dim PutRows  As Worksheet 
Dim sglRowNum As Single, i% 


If strMissingSheet = strMASTERSHEET Then ' Create the strMASTERSHEET 

    Set GetRows1 = Sheets(strRAWDATA)  ' These two sheets could be missing but will code around that later. 
    Set GetRows2 = Sheets(strDATAWITH)  ' The two sheets I am getting rows from 

'只是创造一个新的工作在这里假定它缺少 Worksheets.Add(后:=工作表(5))。名称= strMissingSheet 设置PutRows =表( strMissingSheet)'必须在声明之前创建缺少的表格。

PutRows.Select 'Select the sheet being built. 

    With Cells(1, 1) 
    .Value = strRAWDATA 'Not copying rows here but left it in this example anyway 
    .AddComment 
    .Comment.Visible = False 
    .Select 
    .Comment.Text Text:= _ 
     Chr(10) & "Name of sheet including header and the last 32 entries at the time this sheet was updated." 
    End With 

'这里是我们将整行从一张纸复制到另一张的地方。

GetRows1.Rows(1).Copy PutRows.Rows(2) 'Copy header row from existing sheet to "Master Sheet" for instance. 
    GetRows1.Select 
    sglRowNum = ReturnLastRow(ActiveSheet.Cells) 'return last row with data on active sheet 

“我想数据的最后几行‘32行’,所以发现薄片的这段代码可以在互联网上的几个地方,包括这个网站上找到结束。

'现在您可能一直在寻找的代码将32行数据从一个表单移动到另一个表单。

For i = 1 To 32 'Start at row 3 on the Put sheet after sheet name and header. 
    GetRows1.Rows(sglRowNum - (32 - i)).Copy PutRows.Rows(i + 2) 
    Next i 

末次

+0

开始格式化你的代码 - 失去了耐心;-)请修改和完善(一个代码行需要4个前导空格) – kleopatra

2

此代码工作正常。只需复制并粘贴即可。

Dim CopyFrom As Object 
Dim CopyTo As Object 
Dim CopyThis As Object 
Dim xl As Object 

xl = CreateObject("Excel.Application") 
xl.Visible = False 
CopyFrom = xl.Workbooks.Open("E:\EXCEL\From.xls") 
CopyTo = xl.Workbooks.Open("E:\EXCEL\To.xls") 
For i = 0 To 1 
    ''To use a password: Workbooks.Open Filename:="Filename", Password:="Password" 
    If i = 0 Then 
     CopyThis = CopyFrom.Sheets(1) 
     CopyThis.Copy(After:=CopyTo.Sheets(CopyTo.Sheets.Count)) 
     CopyTo.Sheets(3).Name = "Sheet3" 
    Else 
     CopyThis = CopyFrom.Sheets(2) 
     CopyThis.Copy(After:=CopyTo.Sheets(CopyTo.Sheets.Count)) 
     CopyTo.Sheets(4).Name = "Sheet4" 
    End If 
Next 
CopyTo.Sheets(1).Activate() 
CopyTo.Save() 
'CopyTo.SaveAs("E:\EXCEL\Check.xls") 
xl.Quit() 
相关问题