Error pasting data in Excel with VBS

Asked

Viewed 1,097 times

1

I have a simple spreadsheet in Excel(3 cols and 2 lines) and am trying to create a script to open it, copy your data and insert them into other spreadsheet with the same structure using a form.

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

This script lists all the files in the current directory and allows the user to choose from which Excel file he wants to copy (single or multiple file). Basically, the whole script works well, but the only error is returned in the last line.

Error:

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

Line of Error:

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

This line is responsible for pasting the data into the other sheet. If I comment on this line the script will run perfectly and switch to Range ("A" & usedRowsNumber + 1) .Select it works perfectly and selects the referenced cell, but if it is to paste the data will not, the funniest thing is that the data actually go to the clipboard, so much that even giving error, it is possible to paste in the Ctrl + V in another spreadsheet.

1 answer

1


About your code above, as I mentioned before is a particularly common problemVoce needs to specify where Voce wants events/properties to occur. In case the problem seems to me that Excel does not know where to run things and gets lost and finally the error. I suggest from now on declare variables of type Object and SET with the objects you are accessing. Example in this case the Workbook father where the code is Sheet(1) where you are dumping the copied values.

Avoid using too much of Activesheet, active... Something. Or even Selection.

Follow the code with the changes. Test and see if this helps you.

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

Browser other questions tagged

You are not signed in. Login or sign up in order to post.