我在名为AM,MD,PM的3个XLS文件中有数据。我想使用VBA将所有3个XLS文件合并为1个XLS文件。
这3个XLS文件中的数据我也只希望从特定的行和列中获得。例如说从单元格A41到A53,B41到B53直到所有3个文件的U41到U53。结果,我希望只用剩下的行和列来合并生成xls文件。
生成此合并文件后,我想将这些值导入到主模板XLS文件中。因此,当我单击主Excel模板文件上的按钮时,它将合并3个XLS文件,生成一个文件,并应在主模板XLS文件中反映其值。[在此处输入图片描述] [1]
[在此处输入图片描述] [2]
在此处输入图片描述
Sub loopthroughDirectory()
Dim Myfile As String
Dim erow
Myfile = Dir("L:\Dept\TRANSPORTATION-ENGINEERING\TRAFFIC\_G ITS Projects\MS2\test\")
Do While Len(Myfile) > 0
If Myfile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (Myfile)
Range("A41:T53").Copy
ActiveWorkbook.Close
erow = car.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Car").Range(Cells(erow, 1),
Cells(erow, 20))
Myfile = Dir
Loop
End Sub
但这不起作用。它能够打开文件,但值未粘贴到我尝试生成的统一文件中。 建议将不胜感激。
答案 0 :(得分:0)
我更喜欢通过“文件”对话框选择文件以获得一致性和可靠的结果,但要花几秒钟的时间多次选择文件。适用于您情况的代码可能是这样的:
Option Explicit
Sub Consolidation()
Dim CurrentBook As Workbook
Dim WS As Worksheet
Dim wsn As Worksheet
Set WS = ThisWorkbook.Sheets("car")
Dim IndvFiles As FileDialog
Dim FileIdx As Long
Dim i As Integer, x As Integer
Set IndvFiles = Application.FileDialog(msoFileDialogOpen)'Select your AM,Md, Pm files here
With IndvFiles
.AllowMultiSelect = True
.Title = "Multi-select target data files:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xls files", "*.xls"
.Show
End With
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For FileIdx = 1 To IndvFiles.SelectedItems.Count
Set CurrentBook = Workbooks.Open(IndvFiles.SelectedItems(FileIdx))
Set wsn = CurrentBook.Sheets(1)
Dim LRow1 As Long
LRow1 = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
Dim LRow2 As Long
LRow2 = CurrentBook.ActiveSheet.Range("A" & CurrentBook.ActiveSheet.Rows.Count).End(xlUp).Row
Dim ImportRange As Range
Set ImportRange = CurrentBook.ActiveSheet.Range("A41:T53")' As per yr code adjust if required
ImportRange.Copy
WS.Range("A" & LRow1 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Next
CurrentBook.Close False
Next FileIdx
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub