Página 1 de 1

Copiar celulas específicas de outra planilha

Enviado: 29 Jul 2019 às 12:08
por Andradde1994
Boa tarde, estou quebrando a cabeça desda sexta feira tentando fazer isso...
Meu problema é o seguinte, tenho centenas de planilhas convertidas de PDF, cada uma é uma determinada nota, preciso copiar de cada uma delas determinadas células que contém os dados que preciso... data, valor, numero da nota, empresa etc... e reorganizar tudo em uma única base de dados... até consegui encontrar na internet uma macro que copia toda a planilha e junta todas em um único arquivo... achei que talvez fosse possível alterar ela para fazer o que preciso... mas até agora sem sorte... alguém poderia me ajudar por favor? desde já agradeço!

Segue abaixo a macro que consegui encontrar:

'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

Copiar celulas específicas de outra planilha

Enviado: 29 Jul 2019 às 13:01
por eduardogrigull
Os dados estão sempre padronizados? Tens alguma planilha de exemplo, e uma base de dados de exemplo?

Copiar celulas específicas de outra planilha

Enviado: 29 Jul 2019 às 13:16
por Andradde1994
sim... os dados estão sempre na mesmas células... segue o link de uma pasta no drive com os arquivos... me avise caso eu possa dar mais detalhes.
https://drive.google.com/drive/folders/ ... sp=sharing

Copiar celulas específicas de outra planilha

Enviado: 29 Jul 2019 às 14:47
por Andradde1994
Eu preciso isolar algumas células na nota... e organizar elas pra criar uma base... depois eu posso usar como base para os cálculos que preciso.

Re: Copiar celulas específicas de outra planilha

Enviado: 29 Jul 2019 às 15:30
por eduardogrigull
Fiz um protótipo. É bem trabalhoso fazer tudo, mas podes tentar algo a partir disso.
Voce executa a sub Unificar planilhas, e depois a sub Organizar

Copiar celulas específicas de outra planilha

Enviado: 29 Jul 2019 às 15:36
por Andradde1994
Cara muito obrigado! me ajudou mui! vc nao tem ideia