是否可以将所有工作簿表中的数据从一个Excel工作表( ex:A.xls )复制到另一个excel( ex:B.xls ) 。
可以使用VB实现逻辑,无论A.xls中的工作簿数量多少都可以实现(即它应该复制 A.xls 的所有页面的所有数据)到 B.xls )
我感谢任何帮助,因为我不是来自编程背景。
答案 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