如果有数据,则循环遍历单元格并将数据复制到下一个5个单元格

时间:2015-10-06 20:23:28

标签: vba excel-vba excel

下午好,

我有一个工作表,我需要一个宏来复制D1中的值并将其粘贴到接下来的5个单元格(粘贴到E1:I1),然后如果下一个单元格有数据(J1)则将其复制并粘贴到下一个五个单元格等,直到下一个单元格为空(问题是每次此电子表格具有不同的列数)。我确实尝试用宏录制器执行此操作但我必须每次设置要复制数据的单元格以及要将其粘贴到的单元格。必须有一个比这更简单的方法,任何帮助将不胜感激。 Range("D1").Select Selection.Copy Range("E1:I1").Select ActiveSheet.Paste Range("J1").Select Application.CutCopyMode = False Selection.Copy Range("K1").Select ActiveWindow.SmallScroll ToRight:=10 Range("K1:O1").Select ActiveSheet.Paste Range("P1").Select Application.CutCopyMode = False Selection.Copy Range("Q1:U1").Select ActiveSheet.Paste Range("V1").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll ToRight:=12 Range("W1").Select ActiveSheet.Paste Range("X1:AA1").Select ActiveSheet.Paste Range("AB1").Select Application.CutCopyMode = False Selection.Copy Range("AC1:AG1").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=8 Range("AH1").Select Application.CutCopyMode = False Selection.Copy Range("AI1:AM1").Select ActiveSheet.Paste Range("AN1").Select Application.CutCopyMode = False Selection.Copy Range("AO1:AS1").Select ActiveSheet.Paste

4 个答案:

答案 0 :(得分:1)

我会通过使用RC表示法和循环这样的东西来做到这一点:

dim myValue
dim c as integer
dim x as integer

c=4 'Start in column D
myValue = cells(1,c).value 'Row 1 of column D
while myValue <> ""
    for x = 1 to 5
        cells(1,c+x).value=myValue
    next x
    c=c+x+1 'To give us the 10th column: J
    myValue = cells(1,c).value
wend

答案 1 :(得分:1)

请考虑以下内容,首先找到电子表格中的最后一列,并使用Cells(r, c)引用对每5列进行迭代以进行编号:

Sub CopyNextFive()

    LastColumn = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column

    For i = 4 To LastColumn Step 6
        Cells(1, i).Copy
        Range(Cells(1, i + 1), Cells(1, i + 5)).PasteSpecial xlPasteAll            
    Next i        
    Application.CutCopyMode = False       

End Sub

答案 2 :(得分:1)

Sub mySub()
    Dim src As Range: Set src = ActiveSheet.Range("D1")
    Dim dest As Range: Set dest = ActiveSheet.Range("E1:I1")
    Do Until Trim(src.Text) = vbNullString
        src.Copy dest
        Set src = src.Offset(, 6): Set dest = dest.Offset(, 6)
    Loop
End Sub

答案 3 :(得分:1)

你需要运行某种形式的循环。有几种类型:npm run ensuredirsFor ... Next等。阅读有关它们的内容(http://www.excelfunctions.net/VBA-Loops.html),您会看到它们为您提供了极大的多功能性。

在您的情况下,许多解决方案之一可能如下:

Do Until ...