Question

我想将两个工作表中的数据合并到一个工作表中。

＆＃34; PUF＆＃34;工作表包含一个更大的数据集，所有案例按＆＃34; ID＆＃34;排序。这些案例ID的较小子集包含名为＆＃34; ADHD＆＃34;的第二个工作表中的其他数据。

我的目标是将更多数据复制到较小的＆＃34; ADHD＆＃34;工作表，并将其粘贴到＆＃34; PUF＆＃34;中的数据旁边。工作表。 ID必须匹配。

这是我写的代码。

Sub copypuf()

For x = 2 To 2967

'get ID number of case in ADHD worksheet

Dim y As Long

y = Worksheets("ADHD").Cells(x, 1).Value

y = y + 1

'Copy cells from from ADHD worksheet, into the respective ID number on original data sheet

Worksheets("ADHD").Range(Cells(x, 1), Cells(x, 261)).Copy Worksheets("PUF").Range(Cells(y, 368), Cells(y, 628))

Next x

End Sub

我得到的错误消息是＆＃34;运行时错误1004;应用程序定义的或对象定义的错误＆＃34;

请帮助我非常缺乏经验。

Answer 1

Sub copypuf()
    Dim y As Long

    For x = 2 To 2967

        y = Worksheets("ADHD").Cells(x, 1).Value + 1

        Worksheets("ADHD").Cells(x, 1).Resize(1, 261).Copy _   
                            Worksheets("PUF").Cells(y, 368)
    Next x

End Sub

Answer 2

如果您通过创建Range对象变量并将它们分配到您希望数据运行的工作表范围来使用范围对象，这会有所帮助。

 Sub copypuf()
  Dim x As Long
  Dim r1 As Range 'range for smaller dataset
  Dim r2 As Range 'range for larger dataset
  Dim r4 As Range 'range to check if find is a success
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim y As Long
 Set ws1 = ThisWorkbook.Worksheets("ADHD") 'smaller dataset copy to the below larger dataset
 Set ws2 = ThisWorkbook.Worksheets("PUF") 'larger dataset get values from above offset
y = 1

 Dim idNum As Variant

 With ws1
    Set r1 = .Range(.Cells(2, 1), .Cells(2967, 261)) 'ADHD range
 End With

For x = 1 To r1.Rows.Count

    idNum = r1.Item(x, 1).Value 'get ID number in ADHD worksheet

    y = y + 1

With ws2
    Set r2 = .Range(.Cells(y, 368), .Cells(y, 628)) 'PUF range
End With

 'Copy cells from from ADHD worksheet, into the respective ID number on       original data sheet
With r1 ''copy the cells from the range
    Range(.Cells(x, 1), .Cells(x, .Columns.Count)).Copy
End With

Set r4 = r2.Find(idNum) 'Find the next id number if it is not found nothing is returned

If Not r4 Is Nothing Then
    With r2
        .Offset(0, .Columns.Count).PasteSpecial (xlPasteValues)
    End With
 End If
    Set r2 = Nothing
    Set r4 = Nothing
Next x
Set r1 = Nothing
Set ws1 = Nothing
Set ws2 = Nothing

End Sub

运行时错误1004复制和粘贴工作表

2 个答案: