CODEWITHSUNDEEP
vbaexcel
Darin
Darin

Reputation: 47

Add worksheet and combine data

I have a workbook with 2991 worksheets. Each sheet containing information on trucks. Each worksheet is named city,state. For example Juneau, AK. Each worksheet is also formatted exactly the same.

I have code that copies the data from each workbook (excluding the headers) and places it in a "combined" worksheet.

I would like to expand the code so that when a worksheet gets copied the city and state are placed in new separate columns. For example for Jeneau, AK when the data gets copied next to each truck the city Juneau is placed in column F and the state "AK" is placed in column G.

I have the code listed below as well as example screenshots. 

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

Upvotes: 0

Views: 268

Answers (1)

JNevill
JNevill

Reputation: 50019

I think the following will do what you need:

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

I rewrote the bit before the for loop to remove all the selecting and activating and whatnot and also to get rid of the the ordinal sheet references and make everything more explicit. The rewrite also makes use of the Worksheets.Add() method to create the new worksheet.

The big change here is:

  1. Grabbing the starting row of the paste destination into a variable pasteStartRow so we can reuse it when we paste in the city and state

  2. Grabbing the ending row of the paste destination after we paste into a variable pasteEndRow, again so we can reuse it with City/State

  3. Using an Array sheetName and Split() to grab the comma delimited city, state value from the Sheets(J).name.

  4. Writing the value of the city and state (sheetName(0) and sheetName(1), respectively) into columns f and g on the Combined worksheet.

I also added a wsCombined.activate at the end so that your combined worksheet is activate after everything is run.

Upvotes: 1

Related Questions