Caríssimos,
tenho um código que cria planilhas em várias abas de uma pasta a partir de uma planilha principal e indexado por uma coluna. por exemplo: na coluna que serve de índice para criar as planilhas têm nomes de cada agência, daí a sub verifica as linhas que possuem casa nome de agência e coloca na planilha correspondente.
o problema é que, ao criar as planilhas eu preciso atribuir algumas condições a algumas células, pois as planilhas serão usadas por outras pessoas para inserir informações.
já consigo atribuir a condição de não bloquear as células para a edição quando eu bloquear as planilhas, com a linha a seguir: Range("Z4:AH3000").Locked = False. gostaria de umas linhas para atribuir validação de dados, como por exemplo para a pessoa só conseguir inserir data ou as palavras "sim" ou "não". é complicado criar várias planilhas e ter que fazer essas atribuições uma por uma.
outra solução seria conseguir copiar de uma forma que as atribuições das células da planilha original sejam copiadas para as planilhas criadas, o que não acontece com o código que eu tenho conforme abaixo.

Sub FiltraEmAbas()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Dim rng1 As Range

Set ws1 = Sheets("Consolidada")

'Calcula e Monta o range Nomeado
Call AddNameRange

Set rng = Range("Database")
Set rng1 = ActiveWorkbook.Worksheets("top").Range("Z1:AH2")
'extrai uma lista geral '1 3 E 4
ws1.Columns("F:F").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("AK1"), Unique:=True
r = Cells(Rows.Count, "AK").End(xlUp).Row

'estabelece uma área de critério ' 1
Range("AM1").Value = Range("F1").Value

For Each c In Range("AK2:AK" & r)
'adiciona a lista geral cada noma à área de critério ' 1
ws1.Range("AM2").Value = c.Value
'adiciona uma nova sheet e aciona o filtro avançado
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Consolidada").Range("AM1:AM2"), _
CopyToRange:=wsNew.Range("A3"), _
Unique:=False
' rng.AdvancedFilter Action:=xlFilterCopy, _
' CriteriaRange:=Sheets("top").Range("A1:AH2"), _
' CopyToRange:=wsNew.Range("A1"), _
' Unique:=False

wsNew.Columns("AK:AM").Delete
'copiar as células TOP
rng1.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsNew.Range("Z1:AH2"), Unique:=False
Range("Z4:AH3000").Locked = False
Cells.Select
Cells.EntireColumn.AutoFit
Next

ws1.Select
ws1.Columns("AK:AM").Delete
End Sub

Quero deixar claro que esse código eu peguei na internet e adaptei e fiz meus acréscimos, conforme minhas necessidades.