我如何编写循环以在excel中复制和粘贴多行?

问题描述 投票:0回答:2

所以我的桌子很长,我想在一页上容纳每90个单元格。我试图编写一个循环来一次复制和粘贴每45行,但是我真的不知道该怎么做。任何帮助都感激不尽!预先谢谢你。

Sub Macro2()

    Range("A47:C92").Select         (I selected 45 rows a time)
    Selection.Cut
    Range("E1").Select             
    ActiveSheet.Paste
    Columns("F:F").ColumnWidth = 15.67
    Range("A47:C92").Select
    Selection.Delete Shift:=xlUp

    Range("A93:C138").Select
    Selection.Cut
    Range("E47").Select
    ActiveSheet.Paste
    Range("A93:C138").Select
    Selection.Delete Shift:=xlUp

    Range("A139:C184").Select
    Selection.Cut
    Range("E93").Select
    ActiveSheet.Paste
    Range("A139:C184").Select
    Selection.Delete Shift:=xlUp
End Sub
excel vba
2个回答
0
投票

这里有一个模式,因此您可以编写这样的循环:(我可能在递增时出错了,但是要一直尝试直到正确为止。重要的一点是循环语法)。

dim i  as integer
for i  = 2 to 1000000
  i = i + 45
  dim z as integer
  z = i + 45
   Range("A" & i & ":C" & z).Select        ' (I selected 45 rows a time)
    Selection.Cut
    Range("E1").Select             
    ActiveSheet.Paste
    Columns("F:F").ColumnWidth = 15.67
    Range("A" & i & ":C" & z).Select
    Selection.Delete Shift:=xlUp
next i

0
投票

我认为这是您想要做的。例如,如果您在“ A”列中有1到300个数据,则希望将其拆分为2列,其中“ A”列将包含1到45,而“ E”列将包含46到90。因此总数为165行以覆盖所有300个数据。它看起来像这样...

1个234567891011

代码将使其如下所示(我已显示3行,但您需要45行)...

1 42 53 67 108 119
Sub make_dual_column()
'speed up's the process
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


Dim i As Integer, last_row As Integer
'last row of col A
last_row = Range("A" & Rows.Count).End(xlUp).Row
'last row of col E
col_E_last_row = Range("E" & Rows.Count).End(xlUp).Row

'''every after 45 rows, copy the next 45 rows
'''and paste it in column E 
For i = 1 To last_row Step 45
    If i Mod 2 = 0 Then            
        Range("A" & i & ":C" & i + 44).Select
        Selection.Copy
        Range("E" & col_E_last_row & ":G" & col_E_last_row + 44).Select
        ActiveSheet.Paste
        Range("A" & i & ":C" & i + 44).Select
        Selection.ClearContents
        'update the last empty row of column E
        col_E_last_row = Range("E" & Rows.Count).End(xlUp).Row + 1
    End If
Next
    ' delete all empty cells from column A
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
    ActiveWorkbook.Save

'back to normal default state
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.