Excel VBA: автоматизировать копирование диапазонов из разных книг в один конечный лист назначения?

Question

Я собираюсь генерировать некоторые графики из большого количества данных, расположенных в нескольких рабочих книгах. Данные форматируются одинаково во всех книгах и находятся в папках на одном уровне. Я собираюсь перенести части (диапазоны) данных в одну окончательную рабочую книгу, из которой я буду генерировать свои графики.

Это заставило меня подумать, что такие вещи созрели для автоматизации VBA. Единственная проблема, я новичок. Я попытался написать псевдокод, а затем заменить его на то, что я считаю правильным VBA. Я искал примеры и пробовал файлы справки Excel, но где-то пропускаю некоторые важные шаги ... а также некоторые основные шаги.

Многие вещи кажутся неправильными (... по крайней мере, у вас будет что улыбаться до выходных). Если кто-то может указать, где мой мозг покинул меня, я был бы очень благодарен.

Кроме того, как добавить имя файла, из которого получены диапазоны, в столбце 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://i51.tinypic.com/14sm6ac.jpg

Еще раз большое спасибо за любую помощь, которую вы можете оказать мне.

Майкл.

Answer 1

Я не знаю, если это именно то, что вы хотите, но я думаю, что это сблизит вас и даст вам некоторые подсказки о том, как поступить.Мы можем отредактировать это, чтобы сделать это правильно.

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