Question

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

我有代码复制每个工作簿中的数据（不包括标题），并将其放入＆＃34;组合＆＃34;工作表。

我想扩展代码，以便在复制工作表时，将城市和州放置在新的单独列中。例如，对于Jeneau，AK，当数据被复制到每辆卡车旁边时，城市朱诺被放置在F列和状态＆＃34; AK＆＃34;放在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

Original Data

Combined Data

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循环之前重写了该位以删除所有选择和激活以及诸如此类，并且还要删除序数表引用并使一切更明确。重写还使用Worksheets.Add()方法创建新工作表。

这里的重大变化是：

将粘贴目标的起始行抓取到变量中 pasteStartRow所以我们可以在粘贴城市时重复使用它州
在我们之后抓取粘贴目标的结束行粘贴到变量pasteEndRow中，我们可以重复使用它城市/州
使用数组sheetName和Split()来抓取逗号分隔的城市，来自Sheets(J).name的州值。
写出城市和州的价值（sheetName(0)和 sheetName(1)，分别为f和g上的列 Combined工作表。

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

添加工作表并组合数据

1 个答案: