Excel中VBA：从不同的工作簿自动复制范围到一个最终目的地表？ [英] Excel VBA: automating copying ranges from different workbooks into one final destination sheet?

问题描述

我要被从一大堆位于多个工作簿的数据产生一些图表。数据被格式化在所有工作簿完全相同，并驻留在文件夹中的所有在同一水平。我将要带来的部分（范围）的数据整合到一个工作簿最后，我将从我的生成图表。

I'm going to be generating some graphs from a lot of data located in multiple workbooks. The data is formatted exactly the same in all workbooks and reside in folders all at the same level. I'm going to be bringing parts (ranges) of the data into one final workbook where I'll generate my graphs from.

这让我觉得这样的事情已经成熟VB​​A自动化。唯一的问题，我是一个新手。我试着写假code，然后用我的想法是正确的VBA取代它。我看了看周围的例子，并试图Excel帮助文件，但我失踪的地方的一些重要步骤......以及一些基本步骤为好。

This made me think that this sort of thing is ripe for VBA automation. Only problem, I'm a novice. I've tried writing pseudo code and then replacing it with what I think is correct VBA. I've looked around for examples, and tried Excel help files, but I'm missing some important steps somewhere...and some basic steps as well.

许多事情似乎是错误的（...至少你有东西去笑周末之前）。如果有谁能指出哪里我的大脑已经抛弃了我，我会非常感激。

Lots of things seem to be wrong (... at least you'll have something to smile about before the weekend). If anyone can point out where my brain has abandoned me, I'd be very grateful.

此外，如何添加的范围从在B列来到在同一行的文件的名称？的这东西，真的会帮助我，但我不能找到一个示例如何做到这一点。

Also, how do you add the name of the file that the ranges came from in Column B on the same rows? This is something that would really help me but I can't find an example of how to do it.

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

The outcome of the process would look like the image below - but without the colours or the additonal "_b":

再次感谢任何帮助，您可以给我。

Many thanks again for any help you can give me.

迈克尔。

推荐答案

我不知道这是不是你想要什么，但我认为这将让你更接近，给你如何进行一些线索。我们可以修改它，使其正确的。

I don't know if this is exactly what you want, but I think it will get you closer and give you some clues on how to proceed. We can edit it to make it right.

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

这篇关于Excel中VBA：从不同的工作簿自动复制范围到一个最终目的地表？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！