Search code examples
vbaexcelcopy-paste

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.


Solution

  • 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