vba copy problem, error 1004

[delta59]

When I run this code Im getting a run time error '1004': The info connat be pasted becuase the copy area and paste area are not the same size and shape. Here is my code, does anyone know a way to get around this error so it will copy properly?


Sub Table()
Application.ScreenUpdating = False
Dim j As Long
j = 15
Sheets("sheet2").Select
lastline = ActiveSheet.UsedRange.Rows.Count

For i = 1 To lastline

If Sheets("sheet2").Cells(i, 1) = Sheets("sheet1").Range("P8") And _
Sheets("sheet2").Cells(i, 3) = Sheets("sheet1").Range("Q8") And _
Sheets("sheet2").Cells(i, 4) = Sheets("sheet1").Range("R8") Then
tocopy = 1
Else
End If

If tocopy = 1 Then
Rows(i).Copy Destination:=Sheets("sheet1").Cells(j, 11)
j = j + 1
End If
tocopy = 0
Next i
Application.ScreenUpdating = True
If Sheets("sheet1").Cells(2, 1) = 0 Then MsgBox ("Table selection does not exist.")
End Sub

 

[lrobbo314]

This is because you are copyng the entire row from sheet 2 and trying to paste it starting in column 11 on sheet 1. That means that there are 10 columns at the end that go past the total number of columns that excel has available.

 

[lrobbo314]

This should probably work better for you.

Sub Table()
Application.ScreenUpdating = False
Dim j As Long
j = 15
Sheets("sheet2").Select
lastline = ActiveSheet.UsedRange.Rows.Count
For i = 1 To lastline
    If Sheets("sheet2").Cells(i, 1) = Sheets("sheet1").Range("P8") And _
        Sheets("sheet2").Cells(i, 3) = Sheets("sheet1").Range("Q8") And _
        Sheets("sheet2").Cells(i, 4) = Sheets("sheet1").Range("R8") Then
            Rows(i).Range(Cells(i, 11), Cells(i, 20)).Copy Destination:=Sheets("sheet1").Cells(j, 11) ' adjust the cells(i,11) and cells(i,20) to fit the range you want to copy
            j = j + 1
    End If
    
Next i
Application.ScreenUpdating = True
If Sheets("sheet1").Cells(2, 1) = 0 Then MsgBox ("Table selection does not exist.")
End Sub

 

[lrobbo314]

And here it is cleaned up a bit more...

Sub Table()
Application.ScreenUpdating = False
Dim wks1 As Worksheet, wks2 As Worksheet
Dim j As Long
Set wks1 = Sheets("Sheet1")
Set wks2 = Sheets("Sheet2")
j = 15
lastline = wks2.UsedRange.Rows.Count
For i = 1 To lastline
    If wks2.Cells(i, 1) = wks1.Range("P8") And _
        wks2.Cells(i, 3) = wks1.Range("Q8") And _
        wks2.Cells(i, 4) = wks1.Range("R8") Then
            wks2.Range(Cells(i, 11), Cells(i, 20)).Copy wks1.Cells(j, 11) ' adjust the cells(i,11) and cells(i,20) to fit the range you want to copy
            j = j + 1
    End If
    
Next i
Application.ScreenUpdating = True
If wks1.Cells(2, 1) = 0 Then MsgBox ("Table selection does not exist.")
End Sub