Error when pasting data in Excel with VBS

0

I have a simple spreadsheet in Excel (3 cols and 2 lines) and I'm trying to create a script to open it, copy its data and insert it into other worksheets 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 which Excel file they want to copy (single or multiple file). Basically, the whole script works fine, but the only error is returned on the last line.

Error:

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

Error Line:

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

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

    
asked by anonymous 01.12.2018 / 12:17

1 answer

0

On your code above, as I mentioned before is a particularly common problem you need to specify where you want events / properties to occur. In the case the problem seems to me that Excel does not know where to go where to run things and gets lost and finally the error. I suggest that from now on declare variables of the object type and SET in them with the objects they are accessing. Example in this case the workbook parent where the code is and Sheet (1) where you are dumping the copied values.

Avoid using too much ActiveSheet, active ... Something. Or even Selection.

Follow the code with the changes. Test and see if that helps.

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

    
06.12.2018 / 16:40