从两个文件复制数据并将其输入比较表

时间:2012-07-24 19:42:06

标签: excel-vba excel-2007 vba excel

我有两个名为Old Cal和New Cal的文件。我希望能够从每个单独的文件中获取表格并自动将它们复制到新的比较文件中。唯一的问题是,每次收集数据时都会不断有新的文件需要输入到新的比较表中。例如,这次文件被称为Old Cal和New Cal,但是在那些比较之后,我将有两个名为Blue and Red的全新文件,其中包含我需要在另一个新页面上进行比较的全新信息。我需要帮助编写一个宏,每次都可以自动填充我需要在两个文档之间进行的比较表,即使每次都有不同的文件。如果需要更多信息,请告诉我,欢迎任何帮助。谢谢!

1 个答案:

答案 0 :(得分:0)

Tim Williams说使用Application.GetOpenFilename()是一个很好的解决方案。它将打开标准的excel打开文件对话框,但实际上不会打开文件,它只是给你文件名。

要实际打开工作簿,您可以使用Application.Workbooks.Open()。以下是一段代码,您可以修改以供您使用。

Dim file1 as String
Dim file2 as String
Dim book1 as Workbook
Dim book2 as Workbook
Dim comp as Workbook
Dim targetSheet as Worksheet
Dim copySheet as Worksheet
Dim lastRow as Long
Dim lastCol as Long

Set comp = Application.ActiveWorkbook

file1 = Application.getOpenFilename
file2 = Application.getOpenFilename

If file1 <> "False" AND file2 <> "False" Then
   Set book1 = Application.Workbooks.Open(file1)
   Set book2 = Application.Workbooks.Open(file2)

   'Copy the contents from the first sheet of each of the files to a new sheet in a new sheet
   comp.Worksheets.add After:=comp.Worksheets(comp.Worksheets.count)
   Set targetSheet = comp.Worksheets(comp.Worksheets.count)
   Set copySheet = book1.Worksheets(1)
   lastRow = copySheet.Cells.SpecialCells(xlCellTypeLastCell).Row
   lastCol = copySheet.Cells.SpecialCells(xlCellTypeLastCell).Column
   copySheet.Range(copySheet.Cells(1, 1), copySheet.Cells(lastRow, lastCol)).Copy
   targetSheet.Cells(1, 1).PasteSpecial

   Set copySheet = book2.Worksheets(1)
   lastRow = copySheet.Cells.SpecialCells(xlCellTypeLastCell).Row
   lastCol = copySheet.Cells.SpecialCells(xlCellTypeLastCell).Column
   copySheet.Range(copySheet.Cells(1, 1), copySheet.Cells(lastRow, lastCol)).Copy
   lastRow = targetSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
   targetSheet.Cells(lastRow, 1).PasteSpecial

   book1.Close
   book2.Close
End If

这可能不会完全解决你的问题,但它应该是一个很好的起点。现在,它会将两张工作簿的第一张(另一张在另一张上面)复制到原始工作簿中的新工作表上。

希望这会有所帮助,欢迎来到SO