1

Eu tenho uma planilha simples em Excel(3 cols e 2 linhas) e estou tentando criar um script para abri-la, copiar seus dados e inseri-los em outras planilha com a mesma estrutura usando um formulário.

Private Sub UserForm_Initialize()
    Call AddWorkBooksNames
End Sub

Private Sub AddWorkBooksNames()
    ListBox1.MultiSelect = fmMultiSelectMulti
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim relativePath As String
    relativePath = Application.ActiveWorkbook.Path

    Set objFolder = objFSO.GetFolder(relativePath)
    Set workBooksArrayNames = objFolder.Files
    Set objFolder = objFSO.GetFolder(relativePath)
    Set workBooksArray = objFolder.Files

    For Each Workbook In workBooksArray
        If (Workbook.Attributes And 2) <> 2 Then
            ListBox1.AddItem Workbook.Name
        End If
    Next
End Sub

Private Sub CommandButton1_Click()

    Dim arrString As String, usedRowsNumber As Integer, relativePath As String

    relativePath = Application.ActiveWorkbook.Path

    For index = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(index) = True Then
            arrString = arrString + "," + ListBox1.List(index)
        End If
    Next index

    workBooksArrayNames = Split(Mid(arrString, 2), ",")

    For Each workBookName In workBooksArrayNames

        Set excelObject = CreateObject("Excel.application")
        excelObject.Visible = False

        Set WorkbooksObject = excelObject.Workbooks.Open(relativePath & "/" & workBookName)
        Set sheetObject = WorkbooksObject.Sheets(1)
        Set vRange = sheetObject.Range("A2")
        sheetObject.Range(vRange.End(xlToRight), vRange.End(xlDown)).Copy

        excelObject.ActiveWorkbook.Close (False)
        excelObject.Application.Quit

         ThisWorkbook.Sheets(1).UsedRange.Select

        usedRowsNumber = Selection.Rows.count

        Range("A" & usedRowsNumber + 1).PasteSpecial Paste := xlValues

    Next

End Sub

Este script lista todos os arquivos no diretório atual e permite ao usuário escolher de qual arquivo do Excel ele deseja copiar (arquivo único ou múltiplo). Basicamente, todo o script funciona bem, mas o único erro é retornado na ultima linha.

Erro:

Erro em tempo de execução '1004': O método PasteSpecial da classe Range falhou.

Linha do Erro:

Range("A" & usedRowsNumber + 1).PasteSpecial Paste := xlValues

Essa linha é responsável por colar os dados na outra planilha. Se eu comentar esta linha o script rodará perfeitamente e se mudar para Range ("A" & usedRowsNumber + 1) .Select ela funciona funciona perfeitamente e seleciona a célula referenciada, mas se for pra colar os dados não vai, o mais engraçado é que os dados de fato vão para a área de transferência, tanto que mesmo dando erro, é possível colar no Ctrl + V em outra planilha.

1 Resposta 1

1

Sobre seu codigo acima, como mencionei antes é um problema particularmente comum voce precisa especificar onde voce quer que os eventos/propriedades ocorram. No caso o problema me parece que o Excel não sabe de onde para onde quer executar as coisas e se perde e por fim da erro. Sugiro que daqui para frente declare variaveis do tipo object e de SET nelas com os objetos que esta acessando. Exemplo neste caso o workbook pai onde esta o codigo e a Sheet(1) onde esta despejando os valores copiados.

Evite usar muito do ActiveSheet, active...Something. Ou mesmo Selection.

Segue o codigo com as alterações. Teste e veja se isso lhe ajuda.

Private Sub CommandButton1_Click()

    Dim arrString As String, usedRowsNumber As Integer, relativePath As String

    Dim vWbkActual As Object
    Dim vShtActual As Object

    Set vWbkActual = Application.ActiveWorkbook
    Set vShtActual = vWbkActual.Sheets(1)
    relativePath = vWbkActual.Path

    For Index = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(Index) = True Then
            arrString = arrString + "," + ListBox1.List(Index)
        End If
    Next Index

    workBooksArrayNames = Split(Mid(arrString, 2), ",")

    For Each workBookName In workBooksArrayNames

        Set excelObject = CreateObject("Excel.application")
        excelObject.Visible = False

        Set WorkbooksObject = excelObject.Workbooks.Open(relativePath & "/" & workBookName)
        Set sheetObject = WorkbooksObject.Sheets(1)
        Set vRange = sheetObject.Range("A2")
        sheetObject.Range(vRange.End(xlToRight), vRange.End(xlDown)).Copy

        usedRowsNumber = vShtActual.UsedRange.Rows.Count

        vShtActual.Range("A" & usedRowsNumber + 1).PasteSpecial Paste:=xlValues

        excelObject.ActiveWorkbook.Close False

    Next

    excelObject.Application.Quit

End Sub

att.

Hudson Komuro

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .