VB脚本将所有工作表数据复制到另一个Excel工作表

时间:2012-09-05 16:11:32

标签: excel vbscript

是否可以将所有工作簿表中的数据从一个Excel工作表( ex:A.xls )复制到另一个excel( ex:B.xls ) 。

可以使用VB实现逻辑,无论A.xls中的工作簿数量多少都可以实现(即它应该复制 A.xls 的所有页面的所有数据)到 B.xls

我感谢任何帮助,因为我不是来自编程背景。

5 个答案:

答案 0 :(得分:4)

虽然我开始认为您希望将所有数据跨多个标签复制到一个标签页,但如果您确实希望将数据保存在单独的标签页上,则可以使用类似的方法循环浏览A中的工作表。 xlsx并将它们复制到B.xlsx:

Sub copy_sheets()
    Dim eapp As Excel.Application
    Dim wkbk_from As Workbook
    Dim wkbk_to As Workbook
    Dim wksh As Worksheet

    Set eapp = CreateObject("Excel.Application")
    Set wkbk_from = eapp.Workbooks.Open("C:\Documents\Miscellaneous-DT\Excel\a.xlsx")
    Set wkbk_to = eapp.Workbooks.Open("C:\Documents\Miscellaneous-DT\Excel\b.xlsx")
    eapp.Visible = True

    For Each wksh In wkbk_from.Worksheets
       wksh.Copy After:=wkbk_to.Worksheets(Worksheets.Count)
    Next wksh
End Sub

答案 1 :(得分:3)

好了经过很多努力并学习了一些基础知识,我才能得到代码

以下是适用的代码

Set objExcel = CreateObject("Excel.Application") 
objExcel.Visible = True
Set objPasteData = objExcel.Workbooks.Open("C:\A.xlsx") 'Copy From File
Set objRawData= objExcel.Workbooks.Open("C:\B.xls")             'Paste To File
Set obj1 = objPasteData.WorkSheets("RawData") 'Worksheet to be cleared
obj1.Cells.Clear
countSheet = objRawData.Sheets.Count


For i = 1 to countSheet
    objRawData.Activate
    name = objRawData.Sheets(i).Name

    objRawData.WorkSheets(name).Select
    objRawData.Worksheets(name).Range("A2").Select

    objExcel.ActiveSheet.UsedRange.Select
    usedRowCount1 = objExcel.Selection.Rows.Count

    objExcel.Range("A2:H" & usedRowCount1).Copy
    objPasteData.Activate
    objPasteData.WorkSheets("RawData").Select
    objExcel.ActiveSheet.UsedRange.Select
    usedRowCount2= objExcel.Selection.Rows.Count

    objPasteData.Worksheets("RawData").Range("A"& usedRowCount2 + 1 ).PasteSpecial Paste =xlValues

Next
objPasteData.Save

谢谢@Nilpo& @rryanp寻求指导。

答案 2 :(得分:1)

将所有数据从一个工作表复制到另一个工作表的最简单方法是对包含所有已填充单元格的范围使用复制和粘贴操作。

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

Set objWorkbook1= objExcel.Workbooks.Open("C:\test1.xls")
Set objWorkbook2= objExcel.Workbooks.Open("C:\test2.xls")

Set objRange = objWorkbook1.Worksheets("Sheet1").UsedRange.Copy
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial objRange

objWorkbook1.Save
objWorkbook1.Close

objWorkbook2.Save
objWorkbook2.Close

答案 3 :(得分:0)

你说现有的文件是b.xls,wbut如果你覆盖了所有内容,那就没关系了,为什么不用呢

CreateObject("Scripting.FileSystemObject").CopyFile "a.xls", "b.xls", true

答案 4 :(得分:0)

我昨天完成了同样的任务,不得不花费大量时间搜索解决方案的各个部分。由于某些原因,vbs命名常量不可用(至少在较新的Excel版本中)。 下面的脚本经过测试,并且可以在更新的Excel(2016)

中使用
outputFiletype = 51 'type_xlsx

' I assume you want to use the script for different files, so you can pass the name as a parameter
If Wscript.Arguments.Count < 1 Then
    Wscript.Echo "Please specify a name of the Excel spreadsheet to process"
Else
    inputFilename = Wscript.Arguments(0)
    outputFilename = Replace(inputFilename, ".xlsx", "_calc.xlsx")

    Set objExcel = CreateObject("Excel.Application")
    objExcel.DisplayAlerts = False
    ' if you want to make the excel visible (otherwise if it is failed it will hang in a process list)
    'objExcel.Application.Visible = True

    Set currentWorkbook = objExcel.Workbooks.Open(inputFilename)
    Set newWorkbook = objExcel.Workbooks.Add()

    i = 0
    For Each current_sheet In currentWorkbook.Worksheets
        If current_sheet.Visible Then ' copying only the visible ones
            i = i + 1

            Dim new_sheet
            If newWorkbook.Sheets.Count < i Then
                newWorkbook.Sheets.Add , newWorkbook.Sheets(i-1) ' after the last one
            End If
            Set new_sheet = newWorkbook.Sheets(i)
            new_sheet.Name = current_sheet.Name

            current_sheet.UsedRange.Copy
            new_sheet.Select
            new_sheet.UsedRange.PasteSpecial 13 'xlPasteAllUsingSourceTheme - Everything will be pasted using the source theme
            new_sheet.UsedRange.PasteSpecial 8  'xlPasteColumnWidths - Copied column width is pasted
            new_sheet.UsedRange.PasteSpecial 12 'xlPasteValuesAndNumberFormats - Values and Number formats are pasted.
        End If
    Next
    newWorkbook.SaveAs outputFilename, outputFiletype
    currentWorkbook.Close False
    newWorkbook.Close False
    objExcel.Quit
End If