2012-12-06 113 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() 
相關問題