Nasario,

Resgatei as informações pra cada aba sem precisar de VBA (1 fórmula apenas).

Importante: Na aba DETALHADO as UF's TÊM QUE ESTAR EM ORDEM ALFABÉTICA (como estão no momento).

http://www.4shared.com/file/WfpoP6TI/matriz2.html

Me diga se funcionou.

Abs,

Obs1 - Não formatei nada. Deixei pra vc.
Obs2 - Se não houver mais inclusão de dados copie e cole como valor. Fica bem mais leve.

Mandrix,

Resolveu outro problema que eu iria postar aqui também. Estou colocando a formula em outra planilha para uma outra demanda, muito bom cara!

=SE(LIN()-4<$A$4;INDIRETO("DETALHADO!"&SUBSTITUIR(ESQUERDA(CÉL("endereço";B1);LOCALIZAR("$";CÉL("endereço";B1);2)-1);"$";"")&$A$2+LIN()-5);"")

Obrigado.

Mas também é necessário eu criar uma rotina em VBA para que seja feita toda semana essa separação de dados, não em cada guia, mas sim que os dados de cada UF (coluna A) sejam levados para uma pasta de trabalho independente.

Da forma como o você fez já adianta muito a tarefa, pois agora é só mover/copiar numa outra pasta de trabalho.

Valeu mandrix.

Abraço.

Nasario,

Vc viu que com 1 única fórmula nas 800 linhas e 130 colunas de 27 abas é possível matar o problema?

Não esqueça que essa sua macro deve colar formatos e valores (e não fórmulas) para o outro arquivo.

Legal que funcionou.

Abs,

Mandrix,

Sei que é abuso, mas tem como você comentar ela depois? Indireto, CÉL.. etc...

Estou tentando entender como vc chegou nessa formula.

Valeu demais.

Vá em Fórmulas/Avaliar Fórmula e dê uma namorada no F1 (help).

Se não conseguir te explico.

Sem observar o que foi feito em A2, A3 e A4 vc não vai entender mesmo. Nestas 3 células defino o intervalo dinâmico para cada UF.

Me avisa.

Abs,

Nasario, não tenho o excel 2007, então não pude ver seu exemplo, mas se o mesmo tem as ABAS separadas, para criar uma Nova Pasta para cada ABA, você pode utilizar a rotina abaixo:

Sub NovasPastas()
    For Each ws In Worksheets
        ws.Copy
    Next ws
End Sub

Se não for isto, desconsidere ou guarde para uma nova aplicação.

[]s

Bom dia Mauro

Mais uma que vai para o meu arquivo.

Muito bom.

Um abraço.

Mauro,

Mais uma pro meu banco de macros!

Valeu.

Outra forma também seria assim:

(Retirado do livro Macros e VBA, Bill Jellen,2004.5ª tiragem)

Sub splitworkbook()

Dim ws As Worksheet
Dim DisplayStatusBar As Boolean

DisplayStatusBar = Application.DisplayStatusBar

Application.DisplayStatusBar = True
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Sheets
Dim NewFileName As String

Application.StatusBar = ThisWorkbook.Sheets.Count & "Remaining Sheets"

If ThisWorkbook.Sheets.Count <> 1 Then
NewFileName = ThisWorkbook.Path & " " & ws.Name & ".xls"

ws.Copy

ActiveWorkbook.Sheets(1).Name = "Sheet1"
ActiveWorkbook.SaveAs Filename:=NewFileName
ActiveWorkbook.Close SaveChanges:=False

Else

NewFileName = ThisWorkbook.Path & " " & ws.Name & ".xls"

ws.Name = "Sheet1"

ThisWorkbook.SaveAs Filename:=NewFileName

End If

Next

Application.StatusBar = False
Application.DisplayStatusBar = DisplayStatusBar
Application.ScreenUpdating = True

MsgBox "Arquivos separados com sucesso", vbExclamation

End Sub

Cara, fiquei impressionado com a solução que conseguiu dar para esse caso. Estou precisando muito dessa solução, o mais rápido possível. Porém não consegui ver pelo link que colocou. Diz que o link não é válido. Poderia me ajudar? Qual é a fórmula? Como usar? Ficaria muito grato. É urgente. Obrigadão.

Camarada,

Sobe o arquivo aqui no site.

Valeu.

nasario,

Semelhante ao nosso colega preciso separar minha planilha de milhares de linhas em várias planilhas. As novas planilhas são determinadas pelos locais-ver coluna Local.

Fiquei surpreso quando conseguiu a solução por fórmula. Muito legal. Estou postando como me pediu.

Como não consegui anexar aqui, estou passando o link:

http://www.4shared.com/file/TSARYnyt/base.htm

Obrigadão!

Para facilitar estou postando aqui o arquivo.

Outra forma também seria assim:

(Retirado do livro Macros e VBA, Bill Jellen,2004.5ª tiragem)

Sub splitworkbook()

Dim ws As Worksheet
Dim DisplayStatusBar As Boolean

DisplayStatusBar = Application.DisplayStatusBar

Application.DisplayStatusBar = True
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Sheets
Dim NewFileName As String

Application.StatusBar = ThisWorkbook.Sheets.Count & "Remaining Sheets"

If ThisWorkbook.Sheets.Count <> 1 Then
NewFileName = ThisWorkbook.Path & " " & ws.Name & ".xls"

ws.Copy

ActiveWorkbook.Sheets(1).Name = "Sheet1"
ActiveWorkbook.SaveAs Filename:=NewFileName
ActiveWorkbook.Close SaveChanges:=False

Else

NewFileName = ThisWorkbook.Path & " " & ws.Name & ".xls"

ws.Name = "Sheet1"

ThisWorkbook.SaveAs Filename:=NewFileName

End If

Next

Application.StatusBar = False
Application.DisplayStatusBar = DisplayStatusBar
Application.ScreenUpdating = True

MsgBox "Arquivos separados com sucesso", vbExclamation

End Sub

Preciso de uma que faz o inverso desta acima, ou seja, pega vários arquivos e une-os em uma única pasta de trabalho.
Alguém pode ajudar?

Obrigado.