Excel VBA：将复印范围从不同的工作簿自动化到一个最终的目标页？ [英] Excel VBA: automating copying ranges from different workbooks into one final destination sheet?
问题描述
这使我觉得这样事情已经成熟了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
文件夹=数组（ABC，DEF，GHI，JKL）
FileInFolder = Array（ABCFile，DEFFile，GHIFile，JKLFile）
''我的最终Excel文件位于源文件文件夹的父文件夹
DestPath =S：\Common\XYZ\Michael S \Macrotest\
''每个文件都有自己的文件夹，还有每个
中的许多特定文件SourcePath =S：\Common\XYZ\Michael S \Macrotest\ +文件夹
我的每个源都一样文件
Range1 = Cells（C4：C8）
范围2 =单元格（C17：D21）
''下面我试图将Range1粘贴到列C直接在最后使用的单元格下
DestinationPaste1 = Range（C5000）。End（xlUp）.Offset（1，0）
''下面我试图将Range2粘贴到列D直接在最后使用的单元格下
DestinationPaste2 = Range（D5000）。End（xlUp）.Offset（1，0）
''尝试使其循环遍历文件夹， the_
''文件...但这只是一个猜测
对于文件夹中的每个文件夹
''再次猜测
F = 0
该进程的其余部分将打开一个源文件copy_
Range1，然后在列C的第1行打开目标文件并粘贴
。希望它然后返回_
到开源文件copi es Range2并粘贴it_
''下一行在列C
Workbooks.Open FileName：= SourcePath + FileName +Source.xls
工作簿.Sheet（Sheet2）.Range1.Copy
Workbook.Open FileName：= DestPath +Destination.xls
Workbook.Sheet（Sheet1）.DestinationPaste.Select
Selection.PasteSpecial Paste：= xlPasteValuesAndNumberFormats，_
操作：= xlNone，SkipBlanks：= False，Transpose：= True
Windows（SourcePath + FileName +Source.xls）。激活
Workbook.Sheet（Sheet2）.Range2.Copy
Workbook.Open FileName：= DestPath +Destination.xls
工作簿。 Sheet（Sheet1）.DestinationPaste.Select
Selection.PasteSpecial粘贴：= xlPasteValuesAndNumberFormats，操作：= _
xlNone，SkipBlanks：= False，Transpose：= True
Windows + FileName +Source.xls）。激活
ActiveWorkbook.Close
F = F + 1
下一个
End Sub
该过程将如下图所示，但没有颜色或附加的_b：
最终数据输出http://i51.tinypic.com/14sm6ac.jpg
再次感谢任何帮助你可以给我。
Michael。
不知道这是否正是你想要的，但是我认为这会让你更接近，给你一些关于如何进行的线索。我们可以编辑它，使其正确。
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
'sDestPath下的文件夹名称数组
vaFolder = Array（ABC，DEF，GHI，JKL ）
'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\
'打开目标工作簿，将目标表放入变量
设置wbDest = Workbooks.Open（sDestPath&Destination.xls）
设置shDest = wbDest.Sheets（1）
'循环通过文件夹
对于i = LBound（vaFolder）到UBound（vaFolder）
'打开源
设置wbSource = Workbooks.Open（sSourcePath& vaFolder（i）& \& vaFiles（i））
'找到col中的下一个单元格
设置rDest = shDest.Cells（shDest.Rows.Count，3）.End（xlUp）.Offset（1， 0）
'将值从源写入目标
rDest.Resize（5，1）.Value = wbSource.Sheets（1）.Range（C4：C8）。值
'重复下一个源范围
设置rDest = shDest.Cells（shDest.Rows.Count，3）.End（xlUp）.Offset（1，0）
rDest.Resize（5 ，2）.Value = wbSource.Sheets（1）.Range（C17：D21）。值
wbSource.Close False
下一个i
结束Sub
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.
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.
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
The outcome of the process would look like the image below - but without the colours or the additonal "_b":
Final Data Output http://i51.tinypic.com/14sm6ac.jpg
Many thanks again for any help you can give me.
Michael.
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屋！
