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

Question

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

是否可以使用 VB 实现一个逻辑，无论 A.xls 中的工作簿表有多少，它都可以做到这一点（即它应该复制 A.xls 的所有页面的所有数据 B.xls)

感谢任何形式的帮助，因为我不是编程背景。

Answer 1

虽然我开始认为您想将多个选项卡中的所有数据复制到一个选项卡，但如果您真的想将数据保存在单独的选项卡上，您可以使用类似这样的方法来遍历 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

Answer 2

好吧，经过一番努力和学习一些基础知识，我终于拿到了代码

这是有效的代码

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 和@ryanp 的指导。

Answer 3

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

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

Answer 4

你说现有文件 b.xls，但是如果你覆盖所有内容，那没关系，为什么不使用

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

Answer 5

我昨天有同样的任务，不得不花费大量时间寻找解决方案的各个部分。由于某种原因，在 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