I think I'm on the tail end of the project, what I need to add for the code
is to add the email address in cell A1 on each spreadsheet based on the tab
name or the name found in cell a1 (both are the same). I have the total
list of offices on sheet1 and the following sheets are broken out based on
information per office, but not all offices are included.

This information changes daily so not all offices will receive a
spreadsheet.

Here's what sheet1 contains:

colA colB
office name email address

--------------------
The following sheets are the different offices and the names are on the tabs
as well as listed in colA of each individual sheet.
-------------------
What I want the macro to do at this point is insert a row on each sheet and
insert the correct email address found on sheet1 that matches the office
address found on colA which matches the address found on the corresponding
sheet.
So if sheet2 was for office Chicago, the macro would insert a row on line
one, and copy and paste the address found on the correct line from sheet1
where the 'chicago' name was found to the new line on sheet 2, then go to
the next spreadsheet and continue until finished.

I hope I explained this clearly. Thanks for your help.

Sub AAA()
Dim Cell As Range
Dim Sht As Worksheet

Dim Rg As Range
Set Rg = Sheets(1).Range(Range("A1"), Range("A65536").End(xlUp))
For Each Cell In Rg
For Each Sht In ThisWorkbook.Sheets
If Cell.Value = Sht.Name Then
With Sht
.Visible = True
.Activate
.Rows(1).Insert
.Range("A1").Value = Cell.Offset(0, 1).Value
Exit For
End With
End If
Next Sht
Next Cell
End Sub

Wow .. I am pretty excited to try this tomorrow .. thanks for responding and
I'll let you know how this fares. Thanks again.

"Andoni" wrote in message
om...
Sub AAA()
Dim Cell As Range
Dim Sht As Worksheet

Dim Rg As Range
Set Rg = Sheets(1).Range(Range("A1"), Range("A65536").End(xlUp))
For Each Cell In Rg
For Each Sht In ThisWorkbook.Sheets
If Cell.Value = Sht.Name Then
With Sht
.Visible = True
.Activate
.Rows(1).Insert
.Range("A1").Value = Cell.Offset(0, 1).Value
Exit For
End With
End If
Next Sht
Next Cell
End Sub

It didn't work ... The code stopped on
Set Rg = Sheets(1).Range(Range("A1"), Range("A65536").End(xlUp))
with error: Application defined or object-defined error .. when I hover
over the line, the rg shows nothing.

Does anyone have some assistance?


"Andoni" wrote in message
om...
Sub AAA()
Dim Cell As Range
Dim Sht As Worksheet

Dim Rg As Range
Set Rg = Sheets(1).Range(Range("A1"), Range("A65536").End(xlUp))
For Each Cell In Rg
For Each Sht In ThisWorkbook.Sheets
If Cell.Value = Sht.Name Then
With Sht
.Visible = True
.Activate
.Rows(1).Insert
.Range("A1").Value = Cell.Offset(0, 1).Value
Exit For
End With
End If
Next Sht
Next Cell
End Sub