Ola pessoal estou trabalhando nessa macro que preciso abrir vários arquivos no Excel e copiar os dados da colunas A2 e B2 que possuem dados
de todas planilhas porém tem alguns possuem mais planilhas que outros programei e ele funciona porém estou com problema na Do While pois eu programei para se em uma planilha que não tenha valores para ir para a próxima planilha, no entanto quando chega na ultima planilha da erro.
Agradeço a Ajuda abaixo esta o código
Private Sub BtPlaca_Click()
Dim FSO As Object
Dim Pasta As String
Dim Planilha As Object
Dim OpenBook As String
Dim UltCel As Range
Dim W As Worksheet
Dim x As Integer
'Achar útima celula
Set UltCel = Range("A1048576").End(xlUp)
UltCel.Select
ActiveCell.Offset(1, 0).Select
Set FSO = CreateObject("Scripting.FileSystemObject")
Pasta = "C:\Users\Desktop\Base\"
'Pasta com as planilhas que serão abertas e copiadas
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For Each Planilha In FSO.GetFolder(Pasta).Files
If InStr(1, Planilha, ".xls") = 0 Then GoTo PRÓXIMO
Workbooks.Open (Planilha)
OpenBook = ActiveWorkbook.Name
'Verificar se Branco ""
'Do While ActiveCell.Range("a2").Value <> ""
For A = 1 To Sheets.Count
Do While ActiveCell.Range("a2").Value <> ""
Sheets(A).Select
Sheets(A).Range("A2").Select
'código para copiar
ActiveSheet.Range("a2:" & ActiveSheet.Range("b2"). _
End(xlDown).Address).Select
Selection.Copy
'ativar o arquivo de onde os dados foram copiados
Windows(ThisWorkbook.Name).Activate
ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'Ativar depois ultima celula
Range("A2").Select
Set UltCel = Range("A1048576").End(xlUp)
UltCel.Select
ActiveCell.Offset(1, 0).Select
Windows(ThisWorkbook.Name).ActivateNext
ActiveSheet.Next.Select
Loop
Next
PRÓXIMO:
Next
Application.ScreenUpdating = True
MsgBox "Dados Copiados com Sucesso!", vbInformation, "Aviso"
Application.Calculation = xlCalculationAutomatic
End Sub