在search代码Excel Vba中增加行

我困在问题，我的vba不会增加行号。 我的表看起来像：Sheet1

name value aa 11 bb 12 cc 13 aa 14 cc 15 cc 16 aa 17 bb 18 aa 19 

Sheet2中

 name aa bb cc 

我需要search每个特定的值，如果find复制相邻单元格sheet2右下一个search值。 这是代码做，但问题是与行增量，所有search的值在一行（variablesk不工作）。

 Sub finall() Dim cable As String Dim finalrow1 As Integer Dim finalrow2 As Integer Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer l = 2 k = 2 finalrow2 = Sheets("Sheet2").Range("A1000").End(xlUp).Row finalrow1 = Sheets("Sheet1").Range("A1000").End(xlUp).Row For j = 2 To finalrow2 cable = Sheets("Sheet2").Cells(j, 1).Value For i = 2 To finalrow1 If Cells(i, 1) = cable Then Sheets("Sheet1").Cells(i, 2).Copy Sheets("Sheet2").Cells(k, l).End(xlUp).Offset(1, 0).PasteSpecial l = l + 1 End If Next i k = k + 1 Next j End Sub 

这只是最后一个例子，我想把这个代码应用到50-60k行的表中。

决赛桌应该是这样的：

 name aa 11 14 17 19 bb 12 18 cc 13 15 16 

谢谢

Answer 1

最终的代码如下

 Sub finall() Dim cable As String Dim finalrow1 As Long Dim finalrow2 As Long Dim i As Long Dim j As Long Dim k As Long Dim l As Long l = 2 k = 2 finalrow2 = Sheets("Sheet2").Range("A1000").End(xlUp).Row finalrow1 = Sheets("Sheet1").Range("A1000").End(xlUp).Row Worksheets("Sheet2").Select For j = 2 To finalrow2 cable = Sheets("Sheet2").Cells(j, 1).Value For i = 2 To finalrow1 If Sheets("Sheet1").Cells(i, 1) = cable Then Sheets("Sheet1").Cells(i, 2).Copy Sheets("Sheet2").Cells(k, l).PasteSpecial l = l + 1 End If Next i k = k + 1 l = 2 Next j End Sub 

工作certificate