Excel 满足值时粘贴到新行

我试图创建一个代码，自动创建我们在工作中使用的设置。我在一列中收集了所有数据，从那里它必须复制12列宽的行中的数据，每次他遇到值0PBSRC时，它必须从一个新行开始。现在的结果是：

这就是我想要的：

这是我现在拥有的代码：

Sub EMCnaarTaq()

Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Dim rng As Range


Set Sheet1 = ThisWorkbook.Sheets("Mix Overzicht")
Set Sheet2 = ThisWorkbook.Sheets("Taqman Platen")

Set rng = Sheet1.Range("AI2:AI500")


For Each cel In rng

If cel.Value = "0PBS*RC*" Then
    cel.Copy
  '  Worksheets("Taqman Platen").Cells(ActiveCell.Row, 8).Select
  '  ActiveCell.Offset(2, 0).Select
    Range("H" & ActiveCell.Row + 2).Select

    'Worksheets("Taqman Platen").Cells(Offset(2, 0), 8).Select
 '   Sheet2.Cells(Offset(2, 0), ActiveCell.Column).Select
     GoTo Plakken


ElseIf cel.Value >= 1 Then
    cel.Copy

Plakken:

    Dim c
        For Each c In Sheet2.Range("H3:S3,H5:S5,H7:S7,H9:S9,H11:S11,H13:S13")
            If c = "" Then
                c.Select
                c.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False 'Select

               Exit For
            End If


        Next
 Else
 End If

 Next




End Sub

我知道问题是，当满足值0pbsRC时，它会转到新行，但它会一直返回到我选择的范围内的第一个空白单元格。 我已经尝试了很多事情，我觉得我很接近，但我就是找不到解决办法

问候,

---

Patrick

我处理这个问题的方法是声明第二个范围作为粘贴数据的目标，每次将其偏移一列

然后，当点击0PBSRC值时，将目标地址更改为下一个空行的开头，并从那里继续

差不多

set SourceRng = Range(AI1:AI500)
Set TargetRng = Range(H3)

for cel in Sourcerng
TargetRng = TargetRange.offset(0,1)
if TargetRng.column  = 20 #column S or cel.value = 0PBSRC
TargetRng = Range("H" & TargetRange.row+2)
 #do copy / paste here

next cel

---

@Chris Sampson这是我现在得到的代码：

Set Sheet1 = ThisWorkbook.Sheets("Mix Overzicht")
Set Sheet2 = ThisWorkbook.Sheets("Taqman Platen")
Set SourceRng = Sheet1.Range("AI2:AI500")
Set TargetRng = Sheet2.Range("H3")

For Each cel In SourceRng
If cel.Value >= 1 Then
TargetRng = TargetRng.Offset(0, 1)
If TargetRng.Column = 20 Or cel.Value = "0PBS*RC*" Then
TargetRng = Range("H" & TargetRng.Row + 2)
cel.Copy
TargetRng.PasteSpecial
End If
End If
Next cel

---

我终于让它工作起来了，这就是它已经变成的样子

Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Dim SourceRng As Range
Dim TargetRng As Range


Set Sheet1 = ThisWorkbook.Sheets("Mix Overzicht")
Set Sheet2 = ThisWorkbook.Sheets("Taqman Platen")
Set SourceRng = Sheet1.Range("AI2:AI500")

Set TargetRng = Sheet2.Range("H1")

For Each cel In SourceRng
If cel.Value = "0PBS*RC*" Then
    Range("H" & ActiveCell.Row + 2).Select
    cel.Copy
    ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False 'Select

    ElseIf cel.Value >= 1 Then
    ActiveCell.Offset(0, 1).Select
        If ActiveCell.Column = 20 Then
        Range("H" & ActiveCell.Row + 2).Select
        Else
        End If
    cel.Copy
    ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False 'Select
End If
Next cel

---

谢谢你的帮助

为了快速回复，我已经试过了你的建议。虽然我不得不说，我可能还处于新手水平，我可以阅读vba，理解你想让我尝试什么，但我就是无法让它以某种方式工作。。。这就是我现在得到的：抱歉，我似乎无法将代码放入注释中…：/你能描述一下发生了什么吗？什么都没发生。。它目前不复制和粘贴任何内容