我有一个工作表，其中包含多个标识不同数据源的选项卡。我需要将所有工作表合并为一个，并在工作表名称中添加一列作为新合并表的一部分。
我找到了以下代码，如果我将其剪切/粘贴到工作表中，则它的工作方式就像一个迷人的按钮，但我有几本工作簿，而且我必须能够每月重新创建此过程。
我的研究表明，我应该创建一个com add in或可调用的宏来执行此操作，但是每次尝试时，该过程都会失败。如果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
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
您可以将此代码添加到您的“个人宏工作簿”中，然后对其进行修改，使其对ActiveWorkbook起作用。这样，当您运行它时，它将在Excel中选择的任何工作簿上运行。
同样值得用工作簿对象引用来限定所有工作表引用。当您使用（例如）时：
Sheets("Combined")
然后默认情况下将引用ActiveWorkbook。通常这是您想要的（虽然可能不是），但是如果（例如）您在代码中打开/激活了另一个工作簿，并且以其他工作簿作为Sheets(....)参考的目标，则以这种方式工作可能会导致问题。您可以通过始终明确指出要引用的工作簿来解决此问题：例如-
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
因此，修改现有代码：
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
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句