i have to make into a database no big deal, except that
the people who made the spreadsheets set up different worksheets for each employees location.
example they have one worksheet that has all ohio employees, one for all ky etc each worksheet is named after the location. they have 2
spreadsheets each of them has over 50 locations! the worksheets are set up pretty good except they don't have a separate column for location they just depend on the worksheet name. Now i have to add a column for each location and add that location title
to each row yuck!
I wondered how i could create a macro in excel that would automaticlly add a column and put the sheet name in each row?
here is my current macro that combines all worksheets
the people who made the spreadsheets set up different worksheets for each employees location.
example they have one worksheet that has all ohio employees, one for all ky etc each worksheet is named after the location. they have 2
spreadsheets each of them has over 50 locations! the worksheets are set up pretty good except they don't have a separate column for location they just depend on the worksheet name. Now i have to add a column for each location and add that location title
to each row yuck!
I wondered how i could create a macro in excel that would automaticlly add a column and put the sheet name in each row?
here is my current macro that combines all worksheets
Code:
Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("A1").Select
Selection.CurrentRegion.Select ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub