CODEWITHSUNDEEP
vbaexcelcopy-paste
Apis
Apis

Reputation: 103

Copy multiple workbook into single workbook "you cannot paste here because the copy area vba"

I'm trying to open all the selected file using the filedialog method and then copy all the content inside the selected path to the current workbook. The first path file manage to copy all the content, when it come to the second one, the error:

"you cannot paste here because the copy area, select just one cell in the paste area etc."

Below is my code:

Sub Select_File_Click()
Dim lngCount As Long
    Dim cl As Range
    Dim c2 As Range
    Dim ItemType As String

    ThisWorkbook.Sheets("Sheet1").Range("A:D").ClearContents
    Set cl = ActiveSheet.Cells(1, 3)
    ' Open the file dialog
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "comma-separated values", "*.csv"
        .InitialFileName = "*" & ItemType & "*.*"
        .InitialView = msoFileDialogViewDetails
        .Show
        For lngCount = 1 To .SelectedItems.Count

            ' Add Hyperlinks
            cl.Worksheet.Hyperlinks.Add _
            Anchor:=cl, Address:=.SelectedItems(lngCount), _
                TextToDisplay:=.SelectedItems(lngCount)
            ' Add file name
            'cl.Offset(0, 1) = _
            '    Mid(.SelectedItems(lngCount), InStrRev(.SelectedItems(lngCount), "\") + 1)
            ' Add file as formula
            cl.Offset(0, 1).FormulaR1C1 = _
                 "=TRIM(RIGHT(SUBSTITUTE(RC[-1],""\"",REPT("" "",99)),99))"


            Set cl = cl.Offset(1, 0)
            Set c2 = cl.Offset(0, 1)
        Next lngCount
        Sheets(1).Cells(1, 1) = .SelectedItems.Count

End With
End Sub

Sub All_data_Click()
Dim Count As Integer
Dim iLast As Long

ThisWorkbook.Sheets("Copy").Range("A1:AZ5000").ClearContents
Count = ThisWorkbook.Sheets(1).Cells(1, 1)
iLast = 1

For i = 1 To Count
pth = ThisWorkbook.Sheets("Sheet1").Cells(i, 3).Value 'Select folder path
Set LookupWB = Workbooks.Open(Filename:=pth)
Set sourceColumn1 = ThisWorkbook.Sheets("Copy")
Set Source = ActiveWorkbook.Sheets(1)
Set sourceColumn1 = Source.Columns("A:AZ")
Set targetColumn1 = ThisWorkbook.Worksheets("Copy").Rows(iLast)
sourceColumn1.Copy Destination:=targetColumn1   <---Error Here: 
iLast = iLast + sourceColumn1.Range("A" & Rows.Count).End(xlUp).Row
Next i


End Sub

Is there any idea to solve this problem? I'm lost already.

Upvotes: 1

Views: 74

Answers (1)

J.Doe
J.Doe

Reputation: 596

If I understood correctly what you are trying to do, I suggest a slightly different approach in 1 go:

Sub Select_File_Click()
    Dim Wb As Workbook: Set Wb = ThisWorkbook
    Dim Sh1 As Worksheet: Set Sh1 = Wb.Sheets("Sheet1")
    Dim Sh2 As Worksheet: Set Sh2 = Wb.Sheets("Copy")
    Dim i As Integer, Cnt As Integer
    Dim Wbt As Workbook

    Sh1.Range("A:D").ClearContents
    Sh2.Cells.Clear
    Cnt = 1

    ' Open the file dialog
    With Application.FileDialog(msoFileDialogFilePicker) 'Using a file picker instead of open
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "comma-separated values", "*.csv"
        .InitialFileName = "*.*"
        .InitialView = msoFileDialogViewDetails
        .Show

        For i = 1 To .SelectedItems.Count

            'You dont actually need the 4 lines below if you only need to do the copy
            ' Add Hyperlinks
            Sh1.Cells(i, 3).Worksheet.Hyperlinks.Add Anchor:=Sh1.Cells(i, 3), Address:=.SelectedItems(i), TextToDisplay:=.SelectedItems(i)
            ' Add file as formula
            Sh1.Cells(i, 4).FormulaR1C1 = "=TRIM(RIGHT(SUBSTITUTE(RC[-1],""\"",REPT("" "",99)),99))"

            Set Wbt = Workbooks.Open(.SelectedItems(i))
            Intersect(Wbt.Sheets(1).UsedRange, Wbt.Sheets(1).Columns("A:AZ")).Copy Sh2.Range("A" & Cnt)
            Cnt = Cnt + Intersect(Wbt.Sheets(1).UsedRange, Wbt.Sheets(1).Columns("A:AZ")).Rows.Count
            Wbt.Saved = True
            Wbt.Close
        Next i
    End With
End Sub

Upvotes: 1

Related Questions