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

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

可以使用VB实现一个逻辑,在那里它可以做到这一点,不pipeA.xls中的工作簿表的数量(即它应该将A.xls的所有页面的所有数据复制到B.xls

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

虽然我开始认为你想要将所有的数据跨多个标签复制到一个标签,但是如果你真的想把数据保存在不同的标签上,你可以使用类似的方式遍历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 

那么经过很多的斗争和学习一些基础知识,我能够得到的代码

这是有用的代码

 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&@ryryp的指导。

你说现有的文件b.xls,如果你覆盖所有的东西,那么为什么不使用它并不重要

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

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

 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 

我昨天做了同样的工作,不得不花费大量的时间来search解决scheme的各个部分。 由于某些原因,名为常量的vbs不可用(至less在较新的Excel版本中)。 下面的脚本经过testing和certificate,可以在更新的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