宏将其他excel文件合并为一个 [英] macro to consolidate other excel files into one

问题描述

我想发布以下请求：
$




在我的网络上有一个名为"a"的文件夹。子文件夹数量不断变化。在每个文件夹中都有不断变化的excel文件数，所有这些文件都有不同的未知名称。这些文件也有一些共同之处：它们都是
，除了Sheet1，Sheet2和Sheet3之外，还有一个名为"名称"的表格。数据从第5行开始，在A列到第X列。每个文件的填充行数是随机的。



我的问题：



我想制作一个合并的excel文件，我可以在其中加载所有不同的表格，其名称为"名称"。不同的文件。这个合并的excel文件与所有其他excel文件具有相同的格式，这意味着它还有一个名为"Name"的表单。
（或者我们可以称之为"ConsolidatedName"以使其更容易）并且它从第5行开始并在A列中捕获数据直到X.

我想再添加两个细节在右侧;在Y列中，应出现数据行所在文件的名称，在Z列中，应出现行（以及Y列的excel文件）所在文件夹的名称。



我已经开始但它尚未处于最终状态：

  Sub Consolidation（）
 
 Sheets（" ConsolidatedName"）。Range（" A5：X1000000"）。ClearContents 
 
 For Each fl在CreateObject（" scripting.filesystemobject"）中.getfolder（" \\ ... \ a"）。文件
使用Workbooks.Add（fl）
 
 ThisWorkbook。表格（"名称"）。单元格（Rows.Count，1）.End（xlUp）.Offset（1）= fl 
。表格（"名称"）。UsedRange.Copy ThisWorkbook.Sheets（"） ConsolidatedName"）。Cells（Rows.Count，1）.End（xlUp）.Offset（1）
。关闭False 
 
结束
下一个
 
 End Sub  

$
 

解决方案

回复： 合并文件



'试试下面的代码 - 注意笔记。

'添加你需要的名字应该很容易。

'请注意"注释"



 选项比较文本

'打开每个.xls文件在文件夹中，将活动表格$
'移动到包含代码的工作簿。

'Jim Cone - 美国俄勒冈州波特兰 - 最后修改于2008年3月。

Sub FilesToWorksheets_R3（）

  On Error GoTo ThatHurt

  Dim objFSO   作为对象

  Dim objFolder As Object

  Dim objFile  作为对象

  Dim strPath  作为字符串

  Dim strName  作为字符串

  Dim blnTask  作为布尔值



 如果Val（Application.Version）> = 10则为
  blnTask = Application.ShowWindowsInTaskbar
  Application.ShowWindowsInTaskbar = False

 结束如果

  Application.ScreenUpdating = False

'指定文件夹...

  strPath =" C：\Program Files \ Lavasoft \Ad-aware 6 \ Logs"  '注意<<<使用实际路径



'使用Microsoft Scripting运行时。

 设置objFSO = CreateObject（" Scripting.FileSystemObject"）

 设置objFolder = objFSO.GetFolder（strPath）



'检查文件夹中的文件类型并打开文件。

  For each objFile in objFolder.Files

  if objFile.Name like" *。xls"然后'注意：<<<根据需要更改

    strName = objFile.Name

    Application.StatusBar = strName

    Workbooks.Open objFile

   '注意：使用下面的实际工作表名称，而不是"活动工作表"...工作表（"污泥"）。

    ActiveSheet.Name = Left

（strName，30）

    ActiveSheet.Move after：= ThisWorkbook.Worksheets（ThisWorkbook.Worksheets.Count）

   工作簿（strName）。关闭保存更改：= False

 结束如果

 下一个'objFile

关闭输出：

  On Error Resume Next

  Application .ShowWindowsInTaskbar = blnTask

  Application.StatusBar = False

  Application.ScreenUpdating = True

 设置objFSO = Nothing

 设置objFolder =没有任何货物
 设置objFile =无任何货物
 退出Sub $


ThatHurt：

  Beep

  MsgBox" Error" &安培; Err.Number& "&NBSP; " &安培; Err.Description ,,"文本文件创建"

 简历CloseOut

结束子

'--- $
Jim Cone

美国俄勒冈州波特兰市
https://goo.gl/IUQUN2  （Dropbox）

I would like to post following request:


On my network there is a folder called "a" with a changing number of subfolders. In each of these folders there is a changing number of excel files, all of them with different unknown names. There is also something the files have in common: they all have - beside Sheet1, Sheet2 and Sheet3 - a sheet callled "Name" with data starting at line 5 and in columns A till X. The number of filled lines is random per file.

My question:

I would like to make a consolidated excel file in which I can load all the different sheets callled "Name" of the different files. This consolidated excel file has the same format as all the other excel files, meaning it also has a sheet called "Name" (or we can call it "ConsolidatedName" to make it easier) and it captures the data starting line 5 and in columns A till X.
I would like to add two more details on the right side; in column Y the name of the file where the data line comes from should appear and in column Z the name of the folder where the line (and the excel file of column Y) should appear.

I allready started but it's not in an end state yet:

Sub Consolidation()

 Sheets("ConsolidatedName").Range("A5:X1000000").ClearContents

 For Each fl In CreateObject("scripting.filesystemobject").getfolder("\\...\a").Files
 With Workbooks.Add(fl)

 ThisWorkbook.Sheets("Name").Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl
 .Sheets("Name").UsedRange.Copy ThisWorkbook.Sheets("ConsolidatedName").Cells(Rows.Count, 1).End(xlUp).Offset(1)
 .Close False

 End With
 Next

 End Sub

 

解决方案

Re:  consolidate files

'Give the following code a try - note the notes.
'It should be easy to add the names you need.
'Note the "Notes"

 Option Compare Text
'Opens each .xls file in the folder and moves the active sheet
'to the workbook containing the code.
'Jim Cone - Portland, Oregon USA - last modified March, 2008.

Sub FilesToWorksheets_R3()
 On Error GoTo ThatHurt
 Dim objFSO    As Object
 Dim objFolder As Object
 Dim objFile   As Object
 Dim strPath   As String
 Dim strName   As String
 Dim blnTask   As Boolean

 If Val(Application.Version) >= 10 Then
 blnTask = Application.ShowWindowsInTaskbar
 Application.ShowWindowsInTaskbar = False
 End If
 Application.ScreenUpdating = False
'Specify the folder...
 strPath = "C:\Program Files\Lavasoft\Ad-aware 6\Logs"  'Note <<< Use actual path

'Use Microsoft Scripting runtime.
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objFolder = objFSO.GetFolder(strPath)

'Check type of file in the folder and open file.
 For Each objFile In objFolder.Files
 If objFile.Name Like "*.xls" Then 'Note: <<< Change as needed
    strName = objFile.Name
    Application.StatusBar = strName
    Workbooks.Open objFile
   'Note: Use actual sheet name below, not "active sheet"... Worksheets("Sludge").
    ActiveSheet.Name = Left

(strName, 30)
    ActiveSheet.Move after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
    Workbooks(strName).Close savechanges:=False
  End If
 Next 'objFile
CloseOut:
 On Error Resume Next
 Application.ShowWindowsInTaskbar = blnTask
 Application.StatusBar = False
 Application.ScreenUpdating = True
 Set objFSO = Nothing
 Set objFolder = Nothing
 Set objFile = Nothing
 Exit Sub

ThatHurt:
 Beep
 MsgBox "Error " & Err.Number & "  " & Err.Description, , "Text File Creation"
 Resume CloseOut
End Sub

'---
Jim Cone
Portland, Oregon USA
https://goo.gl/IUQUN2 (Dropbox)

这篇关于宏将其他excel文件合并为一个的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！