组合工作表并在Excel中添加列 [英] Combine worksheets and add column in Excel

问题描述

我有一个工作表，其中包含多个标签，用于标识不同的数据源。我需要将所有的工作表组合成一个，并在工作表名称中添加一个列，作为新组合工作表的一部分。

我发现以下代码，如果我剪切/粘贴到我的工作表，它的作用就像一个魅力，但我有几个这些工作簿，我必须能够每月重新创建这个过程。

我的研究表明，我应该创建一个com添加或可调用的宏来做到这一点，但每次我尝试，过程失败。我非常感谢，如果somone可以指出我在Excel（2013）这样做的步骤，并建议我的代码将工作。

提前感谢。

  Sub Combine（）
 Dim J As Integer，wsNew As Worksheet 
 Dim rngCopy As Range，rngPaste As Range 
 Dim Location As String 
 
 On Error Resume Next 
设置wsNew = Sheets（Combined）
 On Error GoTo 0 
'如果工作表不存在，请创建
如果wsNew不是，然后
设置wsNew = Worksheets.Add（before：= Sheets（1））'添加一个工作表首先
 wsNew.Name =组合
结束If 
 
'复制标题并粘贴到以B1开头的新表格
带表格（2）
范围（.Range（A1），.Cells（1，Columns.Count ）.End（xlToLeft））。复制wsNew.Range（B1）
结束
 
'通过单据
对于J = 2 To Sheets.Count从表格2到最后一张
的ave表名称/位置到字符串
位置=表（J）.Name 
 
'要复制的设置范围
带表（J）.Range（A1）。 CurrentRegion 
设置rngCopy = .Offset（1，0）.Resize（.Rows.Count  -  1）
结束
 
'设置范围粘贴到，从列B开始
设置rngPaste = wsNew.Cells（Rows.Count，2）.End（xlUp）.Offset（2，0）
 
'复制范围并粘贴到列*组合表格* 
 rngCopy.Copy rngPaste 
 
'为列A中的所有复制条目输入位置名称
范围（rngPaste，rngPaste.End（xlDown））。偏移量（0，-1 ）=位置
 
下一个J 
结束子
  

解决方案

您可以将此代码添加到您的个人宏工作簿中，并对其进行修改，以使其在ActiveWorkbook上运行。这样，当您运行它时，它将在Excel中选择的任何工作簿进行操作。

同样值得使用工作簿对象引用对所有表格引用进行排序。当您使用（例如）：

 表格（组合）
  pre> 
 
 
那么默认情况下它将引用 ActiveWorkbook 。通常这是你想要的（尽管可能不是这样），但是如果（例如）在代码中打开/激活一个不同的工作簿，那么这种方式可能会导致问题，而另一个工作簿现在就是你的 Sheets（....）参考。通过总是明确指出你所指的工作簿来解决这个问题：例如 -  
  ThisworkBook.Sheets（）'包含运行代码的工作簿
 ActiveWorkbook.Sheets（）'所选工作簿
工作簿（test.xlsx）。名为工作簿
 wb.Sheets（）'的工作簿设置为工作簿对象
  
因此，修改现有代码：
  Sub Combine（）
 Dim wb As Workbook 
 Dim J As Integer，wsNew As Worksheet 
 Dim rngCopy As Range，rngPaste As范围
 Dim位置作为字符串
 
设置wb = ActiveWorkbook 
 
错误恢复下一步
设置wsNew = wb.Sheets（组合）
 On Error GoTo 0 
'如果工作表不存在，创建它
如果wsNew是没有，然后
设置wsNew = wb.Worksheets.Add（之前：= wb.Sheets（1 ））'加一张表st place 
 wsNew.Name =组合
结束如果
 
'复制标题并粘贴到以B1开头的新表单
带有wb.Sheets（2）
 .Range（.Range（A1），.Cells（1，Columns.Count）_ 
 .End（xlToLeft））复制wsNew.Range（B1）
结束于
 
'通过表
对于J = 2从表2到最后一张表
'将表单名称/位置保存到字符串
位置= wb.Sheets（J）.Name 
 
'要复制的设置范围
带有wb.Sheets（J）.Range（A1）。CurrentRegion 
设置rngCopy = .Offset（1，0）.Resize（.Rows.Count  -  1）
结束
 
'设置范围粘贴到列B开始
设置rngPaste = wsNew .Cells（Rows.Count，2）.End（xlUp）.Offset（2，0）
 
'复制范围并粘贴到列* B *组合表
 rngCopy.Copy rngPaste 
 
'输入位置名称i n列A对于所有复制的条目
 wsNew.Range（rngPaste，rngPaste.End（xlDown））。Offset（0，-1）=位置
 
下一个J 
 
 End Sub 
  
 
I have a worksheet that contains multiple tabs that identify different sources of data.  I need to combine all the worksheets into one and add a column with the worksheet name as part of the new combined sheet.

I found the following code and if I cut/paste into my worksheet it works like a charm BUT I have several of these workbooks and I have to be able to recreate this process monthly. 

My research indicates that I should create a com add in or recallable macro to do this but each time I have tried, the process fails.  I would very much appreciate if somone could point me with the steps to do this in Excel (2013) and advise me if my code will work.

Thanks in advance.
Sub Combine()
    Dim J As Integer, wsNew As Worksheet
    Dim rngCopy As Range, rngPaste As Range
    Dim Location As String

    On Error Resume Next
    Set wsNew = Sheets("Combined")
    On Error GoTo 0
        'if sheet does not already exist, create it
        If wsNew Is Nothing Then
        Set wsNew = Worksheets.Add(before:=Sheets(1)) ' add a sheet in first place
        wsNew.Name = "Combined"
    End If

    'copy headings and paste to new sheet starting in B1
    With Sheets(2)
        Range(.Range("A1"), .Cells(1, Columns.Count).End(xlToLeft)).Copy wsNew.Range("B1") 
    End With

    ' work through sheets
    For J = 2 To Sheets.Count ' from sheet 2 to last sheet
        'save sheet name/location to string
        Location = Sheets(J).Name

        'set range to be copied
        With Sheets(J).Range("A1").CurrentRegion
            Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1)
        End With

        'set range to paste to, beginning with column B
        Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)

        'copy range and paste to column *B* of combined sheet
        rngCopy.Copy rngPaste

        'enter the location name in column A for all copied entries
        Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location

    Next J
End Sub

解决方案
You can add this code into your Personal Macro Workbook, and modify it so it acts on the ActiveWorkbook. That way, when you run it, it will operate on whichever workbook is selected in Excel.

Also worth qualifying all your sheet references with a workbook object reference.  When you use (e.g.):
Sheets("Combined")
then by default it will refer to the ActiveWorkbook.  Usually this is what you want (though it may not be), but working this way can cause problems if (for example) you open/activate a different workbook in your code, and that other workbook is now the target of your Sheets(....) reference.  You resolve this by always being explicit about which workbook you're referring to: for example - 
ThisworkBook.Sheets()             'the workbook containing the running code
ActiveWorkbook.Sheets()           'the selected workbook
Workbooks("test.xlsx").Sheets()   'named workbook
wb.Sheets()                       'use a variable set to a workbook object
So, modifying your existing code:
Sub Combine()
    Dim wb As Workbook
    Dim J As Integer, wsNew As Worksheet
    Dim rngCopy As Range, rngPaste As Range
    Dim Location As String

    Set wb = ActiveWorkbook

    On Error Resume Next
    Set wsNew = wb.Sheets("Combined")
    On Error GoTo 0
        'if sheet does not already exist, create it
        If wsNew Is Nothing Then
        Set wsNew = wb.Worksheets.Add(before:=wb.Sheets(1)) ' add a sheet in first place
        wsNew.Name = "Combined"
    End If

    'copy headings and paste to new sheet starting in B1
    With wb.Sheets(2)
        .Range(.Range("A1"), .Cells(1, Columns.Count) _
                   .End(xlToLeft)).Copy wsNew.Range("B1") 
    End With

    ' work through sheets
    For J = 2 To wb.Sheets.Count ' from sheet 2 to last sheet
        'save sheet name/location to string
        Location = wb.Sheets(J).Name

        'set range to be copied
        With wb.Sheets(J).Range("A1").CurrentRegion
            Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1)
        End With

        'set range to paste to, beginning with column B
        Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)

        'copy range and paste to column *B* of combined sheet
        rngCopy.Copy rngPaste

        'enter the location name in column A for all copied entries
        wsNew.Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location

    Next J

End Sub


                        
这篇关于组合工作表并在Excel中添加列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！