粘贴时运行时错误“1004”

我一直在四处寻找,找出为什么这给我一个Run-time error '1004' You can't paste this here because the Copy area and paste area aren't the same size. Select just one cell in the paste area or an area that's the same size, and try pasting again. Run-time error '1004' You can't paste this here because the Copy area and paste area aren't the same size. Select just one cell in the paste area or an area that's the same size, and try pasting again. 但是我没有find我find的解决scheme。

这里的问题只发生在这一行上: ws.Columns(1).Copy Destination:=ws2.Columns(1).Rows(5)

粘贴内容应该是垂直的几个单元,即“B1:B5”。 我不能做范围(“B1:B5”),因为我需要不断更新取决于几件事情。

任何想法,为什么我得到错误?

 Option Explicit Sub chkPercent() Dim wb As Workbook Dim ws As Worksheet Dim ws2 As Worksheet Dim rng As Range Set wb = ActiveWorkbook Set ws = wb.Worksheets(1) Set rng = ws.Range("A1") Dim iq_Array As Variant Dim colNumb As Long Dim rowNumb As Long Application.ScreenUpdating = False colNumb = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column rowNumb = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row Dim iQRef() As String Dim iCol As Long Dim pptText As String ReDim iQRef(colNumb) ' capture IQ refs locally For iCol = 2 To colNumb iQRef(iCol) = ws.Cells(1, iCol).Value Next iCol Worksheets.Add After:=ws Set ws2 = wb.Worksheets(2) pptText = "iq_1,2,3,4" 'Identify if within text there is "iq_" 'If InStr(1, pptText, "iq_") <= 0 Then GoTo nextShpe 'set iq_Array as an array of the split iq's iq_Array = Split(pptText, ",") Dim hasIQs As Boolean Dim checkStr As String Dim pCol As Long Dim checkOne Dim arrayLoop As Long checkOne = iq_Array(0) hasIQs = Left(checkOne, 3) = "iq_" If hasIQs Then ' paste inital column into temporary worksheet ws.Columns(1).Copy Destination:=ws2.Columns(1) End If ' loop for each iq_ in the array For arrayLoop = LBound(iq_Array) To UBound(iq_Array) ' Take copy of potential ref and adjust to standard if required checkStr = iq_Array(arrayLoop) If hasIQs And Left(checkStr, 3) <> "iq_" Then checkStr = "iq_" & checkStr Dim iQRefArray As Variant Dim iQRefString As String Dim checkRefStr As String Dim nCol As Long Dim doUntilCheck As String Dim rowCount As Long Dim copy1 Dim paste1 doUntilCheck = 99 ' Look for existence of corresponding column in local copy array pCol = 0 For iCol = 2 To colNumb iQRefString = Left(iQRef(iCol), Len(iQRef(iCol)) - 1) iQRefArray = Replace(iQRefString, "__", "_") iQRefArray = Split(iQRefArray, "_") checkRefStr = "iq_" & iQRefArray(1) If checkStr = checkRefStr Then pCol = iCol Exit For End If Next iCol If pCol > 0 Then ' Paste the corresponding column into the forming table ws.Columns(pCol).Copy Destination:=ws2.Columns(2) If iQRefArray(2) = "00" Then GoTo nxtArrayLoop nCol = 0 rowCount = 1 Do Until doUntilCheck = "00" Do Until doUntilCheck = "01" nCol = nCol + 1 rowCount = rowCount + rowNumb iQRefString = Left(iQRef(iCol + nCol), Len(iQRef(iCol + nCol)) - 1) iQRefArray = Replace(iQRefString, "__", "_") iQRefArray = Split(iQRefArray, "_") doUntilCheck = iQRefArray(2) If doUntilCheck = "00" Then GoTo nxtArrayLoop If doUntilCheck = "01" Then GoTo nxtArrayLoop ws.Columns(1).Copy Destination:=ws2.Columns(1).Rows(rowCount) ws.Columns(pCol + nCol).Copy Destination:=ws2.Columns(2).Rows(rowCount) Loop Loop End If nxtArrayLoop: Next arrayLoop Application.ScreenUpdating = True End Sub 

错误就像它说的那样。 复制和粘贴范围是两种不同的大小。

代码试图将整个列( ws.Columns(1).Copy )复制到定义的范围( Destination:=ws2.Columns(1).Rows(5) – 我认为这是一个单元格,但我从未使用过那种types的语法)。

如果您需要将复制范围定义为dynamic的,则可以这样做:

 ws.Range(ws.Cells(ws.Rows.Count,1).End(Xlup),ws.Cells(1,1)).Copy Destination:=ws2.Cells(1,1) 

这假定连续的单元格从ws中列A的第1行开始。