copy and paste specific cell(using .find) in worksheet array using vba

Question

The code below selects tabs based on the color of the tab. Each sheet is formatted the same, they just contain different values. I am trying to using .find and offset to find a particular cell (it corresponds with current fiscal week plus one) and then copy and paste that cell as values instead of formulas. The code below selects the tabs needed and locates the correct cell but does not copy and paste that cell as values. I am trying to not name sheets specifically because this code will be used on multiple workbooks all with different tab names.

Sub freeze()

Dim ws As Worksheet
Dim strg() As String
Dim count As Integer
count = 1

For Each ws In Worksheets
    If ws.Tab.Color = 255 Then
        ReDim Preserve strg(count) As String
        strg(count) = ws.Name
        count = count + 1
    Else
    End If

Next ws
Sheets(strg(1)).Select

Dim aCell As Range
Set aCell = Range("B9:B79").Find(What:=Worksheets("EmailTemplate").Range("A1").Value)

If Not aCell Is Nothing Then
Sheets(strg(1)).aCell.Select
    ActiveCell.Offset(0, 6).Select
    Selection.copy
    Selection.PasteSpecial xlPasteValues
Else
End If

   For I = 2 To UBound(strg)
    Sheets(strg(I)).Select False

Next I
End Sub 

Thank you

Answer 1

Update #2 (Sun. 11:15 EDT) Added debug statements to assist you; Needed to add reference to 'ActiveSheet' in the 'Find' Code will loop thru all 'Red' sheets, find a match (if any) and copy/paste values. Debug code will show Red tab names, search value, results, formula, value

Option Explicit

Sub freeze()

Dim ws      As Worksheet
Dim aCell   As Range
Dim strg()  As String
Dim count   As Integer
Dim i       As Integer

count = 0

' Get each RED sheet
For Each ws In Worksheets
    If ws.Tab.Color = 255 Then                      ' Find only RED tabs
        Debug.Print "-----------------------------------------------------------------------"
        Debug.Print "Name of Red Sheet: '" & ws.Name & "'"        ' Debug...
        'ReDim Preserve strg(count + 1) As String
        'count = count + 1                           ' This code not necessary as you can just reference the ws.name
        'strg(count) = ws.Name                       ' Ditto

        Sheets(ws.Name).Select
        Set aCell = ActiveSheet.Range("B9:B79").Find(What:=Worksheets("EmailTemplate").Range("A1").value)
        If Not aCell Is Nothing Then
            ActiveSheet.Cells(aCell.Row, aCell.column).Select
            ActiveCell.Offset(0, 6).Select      ' Offset same row, + 6 columns
            Debug.Print "Found Match for '" & Worksheets("EmailTemplate").Range("A1").value & _
                "' in: R" & aCell.Row & ":C" & aCell.column & vbTab & "Formula: '" & ActiveCell.Formula & "'; Value: '" & ActiveCell.value & "'"
            ' Weird, but was unable to use 'aCell.Select' 2nd time thru loop
            Selection.Copy
            Selection.PasteSpecial xlPasteValues
        Else
            Debug.Print "Did NOT find a match for: '" & Worksheets("EmailTemplate").Range("A1").value & "' in sheet '" & ws.Name & "'"
        End If
        Application.CutCopyMode = False         ' Unselect cell
    End If
Next ws

End Sub

Answer 2

You can't do this:

Sheets(strg(1)).aCell.Select

The sheet is already stored in the range object aCell . You also shouldn't use select and pasting the value is not necessary. Here is what I would do:

Dim aCell As Range
Set aCell = Sheets(strg(1)).Range("B9:B79").Find(What:=Worksheets("EmailTemplate").Range("A1").Value)

If Not aCell Is Nothing Then
    aCell.Offset(0, 6).Value = aCell.Offset(0, 6).Value 
End If

I don't understand what you want to achieve with the second loop. .Select doesn't accept arguments I think? edit : actually .Select does accept the replace option if applied to worksheets to extend the current selection, sorry about that!