Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por davispi 12 Jan 2019 às 20:12
Membro 1 Estrela
Mensagens: 11
Reputação: 0
#40070
Boa noite, encontrei esse código na internet e ele faz exatamente o que eu preciso, porém ele faz um loop copiando os dados de varias planilhas (abas) de um mesmo arquivo, e preciso que ele copia apenas os dados da primeira planilha ( aba "CONSOLIDADO") de cada arquivo e cole em formato especial para valores, se alguém puder me ajudar ficarei muito agradecido.

'UnificarPlanilhas Macro
Sub lsUnificarPlanilhas()
On Error GoTo Sair

Dim lUltimaColunaAtiva As Long
Dim lUltimaLinhaAtiva As Long
Dim lRng As Range
Dim sPath As String
Dim fName As String
Dim lNomeWB As String
Dim lIPlan As Integer
Dim lUltimaLinhaPlanDestino As Long

PlanilhaDestino = ThisWorkbook.Name

sPath = Localizar_Caminho

sName = Dir(sPath & "\*.xl*")

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Do While sName <> ""
fName = sPath & "\" & sName
Workbooks.Open Filename:=fName, UpdateLinks:=False

lNomeWB = ActiveWorkbook.Name

For lIPlan = 1 To ActiveWorkbook.Sheets.Count
Workbooks(lNomeWB).Worksheets(lIPlan).Activate

lUltimaLinhaAtiva = Cells(Rows.Count, 1).End(xlUp).Row
lUltimaColunaAtiva = ActiveSheet.Cells(1, 5000).End(xlToLeft).Column

Set lRng = Range(Cells(1, lUltimaColunaAtiva).Address)

Range("A" & 1 & ":" & gfLetraColuna(lRng) & lUltimaLinhaAtiva).Select
Selection.Copy

Workbooks(PlanilhaDestino).Worksheets(1).Activate

lUltimaLinhaPlanDestino = Cells(Rows.Count, 1).End(xlUp).Row

If lUltimaLinhaPlanDestino > 1 Then
lUltimaLinhaPlanDestino = Cells(Rows.Count, 1).End(xlUp).Row + 1
End If

Range("A" & lUltimaLinhaPlanDestino).Select

ActiveSheet.Paste
Application.CutCopyMode = False
Next lIPlan

Workbooks(lNomeWB).Close SaveChanges:=False
sName = Dir()
Loop

MsgBox "Planilhas unificadas!"

Sair:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

Function gfLetraColuna(ByVal rng As Range) As String
Dim lTexto() As String

lTexto = Split(rng.Address, "$")

gfLetraColuna = lTexto(1)
End Function

Public Function Localizar_Caminho() As String

Dim strCaminho As String

With Application.FileDialog(msoFileDialogFolderPicker)

'Permitir mais de uma pasta
.AllowMultiSelect = False

'Mostrar janela
.Show

If .SelectedItems.Count > 0 Then
strCaminho = .SelectedItems(1)
End If

End With

'Atribuir caminho a variável
Localizar_Caminho = strCaminho

End Function
Avatar do usuário
Por Jimmy 13 Jan 2019 às 17:15
Membro 3 Estrelas
Mensagens: 223
Reputação: 133
#40089
Olá Davi,

Sem um ambiente de testes, no teu caso as outras planilhas, não deu pra testar nada, mas vou te passar umas alterações baseadas apenas na análise do código, e assumindo que a questão se resume apenas a pegar de 1 única planilha, e colar especial.

  • Apague as linhas
    For lIPlan = 1 To ActiveWorkbook.Sheets.Count
    Next lIPlan
  • Altere a linha
    Workbooks(lNomeWB).Worksheets(lIPlan).Activate
    para
    Workbooks(lNomeWB).Worksheets("CONSOLIDADO").Activate
    Se é possível que essa planilha não exista em algum dos arquivos abertos, então é necessário implementar essa consistência.
  • Logo abaixo da linha ActiveSheet.Paste
    inclua a linha Selection.Value = Selection.Value que é um "colar valores" mais simples

Dê retorno do funcionamento

Apenas para enriquecer, faço alguns comentários:

Há algumas atapas feitas em 3 ou 4 linhas, que poderiam ser feitas em 1 (mais complexa). Entendo que fez assim para ficar mais fácil de entender.

É possível eliminar a função gfLetraColuna se trocar as linhas
Set lRng = Range(Cells(1, lUltimaColunaAtiva).Address)
Range("A" & 1 & ":" & gfLetraColuna(lRng) & lUltimaLinhaAtiva).Select
Selection.Copy

pela linha
Range(Cells(1, "A"), Cells(lUltimaLinhaAtiva, lUltimaColunaAtiva)).Copy
pois você não precisa necessariamente do nome da coluna se usar o Cells; ele aceita indexar a coluna tanto pelo nome ("C" por exemplo) como por número (3 no caso da coluna "C"). Importante notar que a ordem dos elementos, comparado com o caso do RANGE("C5"), é invertido, ou seja, Cells(5,3) ou Cells(5,"C").

Não testei nada disso por falta de ambiente de testes.

Jimmy San Juan