Sub Limpar_Coluna()
Range("A:A").Select
Selection.ClearContents
End Sub
Sub Pega_Nome_Planilha_Local()
'-- PEGA O NOME DAS PLANILHAS DENTRO DA PASTA DE TRABALHO
Application.ScreenUpdating = False
Range("A:A").Select
Selection.ClearContents
Range("A1").Select
For i = 1 To Sheets.Count
'Debug.Print Sheets(i).Name
ActiveCell.Value = Sheets(i).Name
Selection.Offset(1, 0).Select
Next i
Application.ScreenUpdating = True
End Sub
Sub BuscaNomePlan_Externa_Mod01()
'-- BUSCAR NOME DAS PLANILHAS EM OUTRA PASTA DE TRABALHO
Application.ScreenUpdating = False
Dim NPlan As String
Dim NPastaTrab1 As String
Dim NPastaTrab2 As String
'-- Pasta de Trabalho a ser busca as Planilhas
Range("C2").Select
Range("A1").Select
NPastaTrab1 = Range("C1").Value
NPastaTrab2 = Range("C2").Value
Windows(NPastaTrab2).Activate
Range("A1").Select
For i = 1 To Sheets.Count
'Debug.Print Sheets(i).Name
NPlan = Sheets(i).Name
Windows(NPastaTrab1).Activate
ActiveCell.Value = NPlan
Selection.Offset(1, 0).Select
Windows(NPastaTrab2).Activate
Next i
Windows(NPastaTrab1).Activate
Application.ScreenUpdating = True
End Sub
'--- MODELO 02
Sub BuscaNomePlan_Externa_Mod02()
'-- BUSCAR NOME DAS PLANILHAS EM OUTRA PASTA DE TRABALHO
Application.ScreenUpdating = False
Dim NPlan As String
Dim NPastaTrab1 As String
Dim NPastaTrab2 As String
'-- Pasta de Trabalho a ser busca as Planilhas
Range("C2").Select
Range("A1").Select
NPastaTrab1 = Range("C1").Value
NPastaTrab2 = Range("C2").Value
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
'-- Vai para a planilha 02
Windows(NPastaTrab2).Activate
Range("A10000").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A10000").Select
For i = 1 To Sheets.Count
'Debug.Print Sheets(i).Name
NPlan = Sheets(i).Name
ActiveCell.Value = NPlan
Selection.Offset(1, 0).Select
Next i
Range("A10000").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A1").Select
Selection.End(xlUp).Select
Windows(NPastaTrab1).Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
End Sub