复制单元格并将它们相乘,然后将每个单元格粘贴在彼此之下

时间:2016-03-22 17:34:29

标签: vba excel-vba excel

我想要复制90个单元格,每个单元格都必须复制到另一列中。每个复制的单元格必须在彼此之下变成52个相同的单元格,并且应该创建所有单元格而不留下任何空白。因此,我应该最终得到4680个单元格,但代码不起作用。

有人可以帮忙吗?

Sub Copy_bud()
Dim WB As Workbook
Dim WS As Worksheet
Dim i, j As Long
Dim kopi As Boolean

Set WB = ThisWorkbook
Set WS = WB.Worksheets("Ark1")

n = WS.Cells(1, 1).CurrentRegion.Rows.Count
j = 1

For i = 1 To n
    While kopi = True
        WS.Cells(i, 1).Select
        Selection.copy
        WS.Cells(j, 5).Paste
        j = j + 51
    Wend 
  Next i
End Sub

1 个答案:

答案 0 :(得分:0)

我不确定我是否理解正确,因为通过查看您的代码对我来说并不是很明显。但也许你一直在寻找这样的东西:

Option Explicit

Sub Copy_bud()

Dim WB As Workbook
Dim WS As Worksheet

Dim lngRow As Long
Dim lngLastRow As Long

Set WB = ThisWorkbook
Set WS = WB.Worksheets("Ark1")

lngLastRow = WS.Cells(1, 1).CurrentRegion.Rows.Count
For lngRow = 1 To lngLastRow
    WS.Range(WS.Cells(1, 4 + lngRow), WS.Cells(lngLastRow, 4 + lngRow)).Value2 = WS.Cells(lngRow, 1).Value2
Next lngRow

End Sub