Question

需要帮助。我有一个文件，其中列A-F有数据，列H-M有数据。我需要代码循环AF并复制单元格A，C，E并将它们粘贴到sheet3上，然后一旦它击中A列中的第一个空白单元格，移动到HM列并循环，复制H，J，K，L在第一个循环完成后，将其移动到第一个空白单元格中的sheet3。以下是我到目前为止，当我到达最后一个＆＃34;下一个cell2＆＃34;我收到一个错误......我是在正确的轨道上吗？有什么指针吗？

Sub Test()



 Dim rowCount2 As Long

rowCount2 = ThisWorkbook.Sheets(2).Range("C20").SpecialCells(xlCellTypeLastCell).Row


Dim rng2 As Range


Set rng2 = ThisWorkbook.Sheets(2).Range("C20:C" & rowCount2)

Dim currentRow As Long
 currentRow = 1


 For Each cell2 In rng2.Cells
 If cell2.Value <> "" Then
 ThisWorkbook.Sheets(2).Rows(cell.Row).Copy Destination:=ThisWorkbook.Sheets(3).Range("A" & currentRow)
 currentRow = currentRow + 1
 GoTo NextIteration

 End If
 Next cell2
NextIteration:
 Next cell2

 End Sub

Answer 1

编辑：我没有完全阅读你的问题，我仍然不确定我是否完全按照你想做的 - 你想要A，C和E进入Sheet3上的A，B，C？这就是我在下面假设的内容。

Sub Test()

    Dim shtDest As Worksheet, shtSrc As Worksheet

    Set shtSrc = ThisWorkbook.Sheets(2)
    Set shtDest = ThisWorkbook.Sheets(3)

    CopyUntilBlank shtSrc.Range("C20"), Array("A", "C", "E"), _
                                        shtDest.Range("A1")

    CopyUntilBlank shtSrc.Range("H20"), Array("H", "J", "K", "L"), _
                   shtDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

End Sub

'Starting with "startCell" and continuing as long as there's a value
'  in that cell, copy the cells with columns in "arrCols" over to the
'  destination starting at "destCell"
Sub CopyUntilBlank(startCell As Range, arrCols, destCell As Range)
    Dim i As Long, n
    Do While Len(startCell.Value) > 0
        For i = LBound(arrCols) To UBound(arrCols)
            startCell.EntireRow.Cells(1, arrCols(i)).Copy destCell.Offset(0, i)
        Next i
        Set startCell = startCell.Offset(1, 0)
        Set destCell = destCell.Offset(1, 0)
    Loop
End Sub

根据行中的非空白数据将特定单元格从一个选项卡移动到另一个选项卡

1 个答案: