从一张纸复制行到另一张

我想从一张纸上复制数据，但条件很less：1.从行1和列1开始，如果R1 C2不为空，则匹配，然后复制R1 C1和R1 C2对，并粘贴到另一张纸上行。 增加列的计数器并将R1 C1与R1 C3相匹配，依此类推。 列计数器达到10时递增行。

我试过下面的代码，但编译错误为Sub或函数未定义。

请帮忙。

Private Sub CommandButton1_Click() Dim x As Integer Dim y As Integer x = 2 y = 2 Do While Cells(x, 1) <> "" If Cells(x, y) <> "" Then Worksheets("Sheet1").Cells(x, 2).Copy Worksheets("Sheet2").Activate erow = Sheet2.Cells(Rows.Count, 1).End(xlUp) > Offset(1, 0).Row ActiveSheet.Paste Destination:=Worksheets("Sheet2").Rows(erow) End If Worksheets("Sheet1").Activate y = y + 1 If y = 10 Then x = x + 1 End If Loop End Sub 

Answer 1

您正在创build该错误，因为在Sheet2.Cells(Rows.Count, 1).End(xlUp) > Offset(1, 0).Row

1. 避免在使用行时使用Integer 。 发布excel2007 ，行数增加， Integer可能无法处理行号。

2. 避免使用。 .Activate 。

这是你正在尝试？ （ 未经testing ）

注 ：我正在演示，因此我正在与Excel单元格直接工作。 但实际上，我将使用自动筛选器和数组来执行此操作。

 Private Sub CommandButton1_Click() Dim wsInput As Worksheet, wsOutput As Worksheet Dim lRowInput As Long, lRowOutput As Long Dim i As Long, j As Long Set wsInput = ThisWorkbook.Worksheets("Sheet1") Set wsOutput = ThisWorkbook.Worksheets("Sheet2") With wsInput lRowInput = .Range("A" & .Rows.Count).End(xlUp).Row For i = 2 To lRowInput If .Cells(i, 2).Value <> "" Then For j = 3 To 10 lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1 .Range(.Range(.Cells(i, 1), .Cells(i, 1)).Address & _ "," & _ .Range(.Cells(i, j), .Cells(i, j)).Address).Copy _ wsOutput.Range("A" & lRowOutput) Next j End If Next i End With End Sub