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

5 回答

• 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
  

  回复于 2024-04-27T02:03:30+08:00
• 0

  好了经过很多努力和学习一些基础知识，我能够得到代码

  这是有效的代码

  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的指导 .

  回复于 2024-04-27T02:03:30+08:00
• 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
  

  回复于 2024-04-27T02:03:30+08:00
• 1

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

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

  回复于 2024-04-27T02:03:30+08:00
• 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
  

  回复于 2024-04-27T02:03:30+08:00