我如何遍历列并将其值复制到另外两列？

我一直在试图创build一个macros，它将通过一个电子表格并复制单元格E中的数字，然后将它们粘贴到单元格K和L中，然后重复作为macros横向列E.即将E1复制到K1和L1，E2将被复制到K2，L2等…

这是我迄今为止所做的：

Sub uy() ' ' Macro1 Macro ' lo ' Range("E299").Select Do Until IsEmpty(ActiveCell) If ActiveCell.Value < 0 Then Selection.Copy Range("K299").Select Do Until IsEmpty(ActiveCell) ActiveSheet.Paste Loop Range("L299").Select Do Until IsEmpty(ActiveCell) ActiveSheet.Paste Loop Else Range("L299").Select Do Until IsEmpty(ActiveCell) ActiveSheet.Paste Loop End If ActiveCell.Offset(1, 0).Select Loop End Sub 

当我运行macros时，它突出显示单元格E229与一个虚线框和单元格K299，L299留空。 我觉得Range("K299").Select, Do Until IsEmpty(ActiveCell), ActiveSheet.Paste部分是select和复制一个空白单元格，所以它会终止自己，因为它符合“做直到IsEmpty（ActiveCell）”标准。

有没有办法让我解决这个问题？

Answer 1

我不太确定我是否正确。 但如果你想复制一个范围到另一个，那么这将做到这一点。

 Private Sub CommandButton1_Click() For i = 1 To Cells(Rows.Count, 5).End(xlUp).Row If Cells(i, 5) <> "" Then Cells(i, 11).Value = Cells(i, 5).Value Cells(i, 12).Value = Cells(i, 5).Value End If Next i End Sub 

只要E列中的单元格'i'不是空的，并且将列E中的单元格'i'的值放入K列和L列

亲切的问候

Answer 2

首先，不要使用Activate或Select 。 在大多数代码中它们都是99％无用的。 接下来，不要使用复制和粘贴。 这种方法很慢。

下面的代码更精简，速度更快。

 Sub EtoKL() Dim WS As Worksheet Dim LRow As Long, Iter As Long Set WS = ThisWorkbook.Sheets("Sheet1") 'Change as necessary. With WS LRow = .Range("E" & .Rows.Count).End(xlUp).Row 'Get last used row in Column E. For Iter = 1 To LRow 'Iterate from 1 to last used row. Union(.Range("K" & Iter), .Range("L" & Iter)).Value = .Range("E" & Iter).Value Next End With End Sub 

让我们知道这是否有帮助。

Answer 3

我认为这样的事情会起作用。

 Sub Copy() Dim intRowCount as Long Dim intLastRow as Long intRowCount = 2 intLastRow = Application.CountA(Sheets(1).Range("e:e")) For intRowCount = 2 To intLastRow Sheets(1).Range("K" & intRowCount ).Value = Sheets(1).Range("E" & intRowCount ).Value Sheets(1).Range("L" & intRowCount ).Value = Sheets(1).Range("E" & intRowCount ).Value Next End Sub