添加工作表并合并数据

我有一个2991工作表的工作簿。 每张表格都包含卡车信息。 每个工作表都被命名为city，state。 例如朱诺AK。 每个工作表格式也完全一样。

我有从每个工作簿（不包括标题）复制数据并将其放置在一个“组合”的工作表中的代码。

我想扩展代码，以便当工作表被复制时，城市和州被放置在新的单独的列。 例如，对于Jeneau，AK，当数据被复制到每辆卡车旁边时，城市Juneau被放置在F栏中，状态“AK”被放置在G栏中。

我有下面列出的代码以及示例屏幕截图。

Sub Combine() Dim J As Integer On Error Resume Next Sheets(1).Select Worksheets.Add Sheets(1).Name = "Combined" Sheets(2).Activate Range("A1").EntireRow.Select Selection.Copy Destination:=Sheets(1).Range("A1") For J = 2 To Sheets.Count Sheets(J).Activate Range("A1").Select Selection.CurrentRegion.Select Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) Next End Sub 

原始数据

组合数据

Answer 1

我认为以下将做你所需要的：

 Sub Combine() Dim J As Integer Dim ws1 As Worksheet Dim wsCombined As Worksheet Dim sheetName() As String Dim pasteStartRow as Integer, pasteEndRow as Integer On Error Resume Next 'Set ws1 to the first worksheet (I assume this has the header row in it) Set ws1 = Sheets(1) 'Create wsCombined as the "Combined" worksheet Set wsCombined = ThisWorkbook.Sheets.Add(ws1) wsCombined.Name = "Combined" 'Copy the first row from ws1 to wsCombined ws1.Rows(1).Copy Destination:=wsCombined.Range("A1") 'Loop through all sheets with data For J = 2 To Sheets.Count 'Get the row on which we will start the paste pasteStartRow = wsCombined.Range("A65536").End(xlUp).Row + 1 'Figure out the copy range Sheets(J).Activate Range("A1").Select Selection.CurrentRegion.Select 'Copy/Paste Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Copy Destination:=wsCombined.Range("A" & pasteStartRow) 'Get the end row of the pasted data pasteEndRow = wsCombined.Range("A65536").End(xlUp).Row 'Split the sheet name by comma and put it into an array sheetName = Split(Sheets(J).Name, ",") 'write out the sheetname to the paste destination from above (using the start and end row that we grabbed) 'Added a trim() to the second item in the array (the state) in case the format of the name is <city>, <state> wsCombined.Range("F" & pasteStartRow & ":" & "F" & pasteEndRow).Value = sheetName(0) wsCombined.Range("G" & pasteStartRow & ":" & "G" & pasteEndRow).Value = Trim(sheetName(1)) Next wsCombined.Activate End Sub 

我在for循环之前重写了这个位，删除了所有的select和激活，也删除了序号表引用，使得所有的东西都更加清晰。 重写也使用Worksheets.Add()方法来创build新的工作表。

这里的重大变化是：

1. 将粘贴目标的起始行pasteStartRow到variablespasteStartRow以便在粘贴城市和州时可以重复使用

2. 在粘贴到variablespasteEndRow之后pasteEndRow粘贴目的地的结尾行，以便我们可以在城市/州

3. 使用Array sheetName和Split()来获取逗号分隔的城市，从Sheets(J).name获取状态值。

4. 将城市和州（ sheetName(0)和sheetName(1)分别写入Combined工作表的f和g列。

我还在最后添加了一个wsCombined.activate ，以便在运行所有内容后激活combined工作表。