Excel宏来整合数据 [英] Excel macro to consolidate data

问题描述

我有一个文件夹中有很多excel文件。

I have many excel files in a folder.

我想要一个宏来迭代每个文件和复制表格，名为最终成本和在目标文件中创建一个包含源文件名称的工作表。

I wanted a macro to iterate through each file and copy sheet named final cost and make a sheet with name of source file in destination file.

像有三个文件A，B，C，每个文件都有一个名为的最终成本

Like there are three files A, B, C each having a sheet named "final cost

新文件将有三张名为

• A， / li>
  
• B，


• C

看起来像

Sub RunCodeOnAllXLSFiles()
    Dim lCount As Long
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook

    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False
    'Application.EnableEvents = False

    'On Error Resume Next

    'Set wbCodeBook = ThisWorkbook

    Dim FilePath    As String, fName As String
    Dim aWB As Workbook, sWB As Workbook

    Set aWB = ActiveWorkbook
    FilePath = "D:\binny\" 'change to suit
    fName = Dir(FilePath & "*.xls")

    Do While fName <> ""
        If fName <> aWB.Name Then
            Set sWB = Workbooks.Open(FileName:=FilePath & fName, UpdateLinks:=0)
            sWB.Worksheets("Final Cost").Range("A1:Z6666").Copy
            sWB.Close False
            Sheets.Add.Name = fName
            Worksheets(fName).Range("D1").Select
            ActiveSheet.PasteSpecial Format:= _
            "Microsoft Word 8.0 Document Object"
        End If
        fName = Dir
    Loop
    Set sWB = Nothing: Set aWB = Nothing


               'Application.ScreenUpdating = True
    'Application.DisplayAlerts = True
    'Application.EnableEvents = True
End Sub

现在要做的是：

1. 保留格式和单元格宽度
2. 
   
3. 我无法获得Paste Special的工作


4. 删除具有相同名称的工作表（如果存在）

推荐答案

你有最多的部分消失了。这是我推荐的。

You have got the most part figured out. Here is what I recommend.

在运行宏的文件中设置1个主工作表的名称，以便删除所有工作表，除了1中的一个工作表走。让我们说主页是MainSheet

Set a name for 1 main worksheet in the file from where the macro is run so that you can delete all sheets except that one sheet in 1 go. Let's say that the main sheet is "MainSheet"

例如

Sub Sample()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "MainSheet" Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next ws
End Sub

现在，您可以将代码添加到代码的开头。我修改了你的代码所有我在代码中做的都是在创建表之后，只需删除Z之后的列。

Now you can add this code to the beginning of your code. I have modified your code. All I am doing in your code is after the sheet is created, simply delete the columns after Z.

看到这个（ UNTESTED ）

Sub test()
    Dim FilePath As String, fName As String
    Dim aWB As Workbook, sWB As Workbook
    Dim ws As Worksheet
    Dim ColName As String

    Set aWB = ThisWorkbook

    '~~> Delete sheets
    For Each ws In aWB.Sheets
        If ws.Name <> "MainSheet" Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next ws

    FilePath = "D:\binny\" '<~~ Change to suit

    fName = Dir(FilePath & "*.xls")

    Do While fName <> ""
        If fName <> aWB.Name Then
            Set sWB = Workbooks.Open(Filename:=FilePath & fName, UpdateLinks:=0)
            sWB.Sheets("Final Cost").Move after:=aWB.Sheets(aWB.Sheets.Count)
            sWB.Close False
            '~~> The sheet is copied, simply delete the columns after Z
            With aWB.Sheets(aWB.Sheets.Count)
                .Name = fName
                .Cells.Copy
                .Cells.PasteSpecial xlPasteValues
                '~~> Get the last column Name
                ColName = Split(.Cells(, .Columns.Count).Address, "$")(1)
                .Columns("AA:" & ColName).Delete
            End With
        End If
        fName = Dir
    Loop
    Set sWB = Nothing: Set aWB = Nothing
End Sub

尝试一下，如果您收到任何错误，请告诉我哪一行我会纠正它。

Give it a try and if you get any errors, let me know which line and I will rectify it.

这篇关于Excel宏来整合数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！