首页 文章

使用循环粘贴13个值2500次

提问于
浏览 次
-2

我是VBA脚本的新手 - 并且一直在尝试 - 从表1“C1：P1”复制值并将它们粘贴在另一张表格中，比如表2中的H表（从H2到H2500） . 基本上代码需要复制值，转置它们并粘贴它们 .

Sub Run()
'
' Run Macro
'

    Dim i As Long

    For i = 1 To 2500
        Sheets("Sheet1").Range("C1:P1").Select
        Selection.Copy
        Sheets("Sheet2").Range("H2:H2500" & i).Offset(13 * i, 0).Select
        Selection.PasteSpecial Paste:=x1PasteFormulas, Operation:=x1None, Skipblanks:= _
            False, Transpose:=True

    Next i

End Sub

必须将Sheet 1从C1到P1的值复制并粘贴到工作表2中的H列中，每个值粘贴13次，并且总共有165个值要复制到工作表2（H列）中 . 运行时错误'1004'是'选择范围类失败的方法'，任何帮助将不胜感激!! :)

excel vba excel-vba for-loop

3 回答

  • 1

    你复制的次数太多了： ...Range("H2:H2500" & i).Offset(13 * i, 0)...

    如上所述，删除 .Select Selection 语句

    Option Explicit

Public Sub CopyCPRow()
    Dim ws1 As Worksheet:   Set ws1 = Sheet1
    Dim ws2 As Worksheet:   Set ws2 = Sheet2
    Dim r As Long, hdr As Range, lr As Long: lr = 2500

    Set hdr = ws1.Range("C1:P1"): hdr.Copy
    With ws2
        Application.ScreenUpdating = False
        For r = 2 To lr Step hdr.Columns.Count
            .Range("H" & r).PasteSpecial Paste:=xlPasteFormulas, _
                                         Skipblanks:=False, Transpose:=True
        Next
        .Rows(lr + 1 & ":" & r).Delete:     .Activate
        Application.ScreenUpdating = True:  .Cells(lr + 1, "H").Select
    End With
End Sub
    回复于
  • 0

    你不需要循环：

    Public Sub CopyCPRow()
    Worksheets("Sheet1").Range("C1:P1").Copy

    Worksheets("Sheet2").Range("H2:H35001").PasteSpecial Paste:=xlPasteFormulas, _
                                                                  Skipblanks:=False, _
                                                                  Transpose:=True
End Sub

    或者，如果您不想将数学留给Excel：

    Public Sub CopyCPRow()
    Dim nCopy As Long

    nCopy = 2500
    With Worksheets("Sheet1").Range("C1:P1")
        .Copy
        Worksheets("Sheet2").Range("H2").Resize(.Columns.Count * nCopy).PasteSpecial Paste:=xlPasteFormulas, _
                                                                                      Skipblanks:=False, _
                                                                                      Transpose:=True
    End With
End Sub
    回复于
  • 1

    Sheets("Sheet1").Range("C1:P1").Select 将无效，除非 Sheet1 当前处于活动状态，同样 Sheets("Sheet2").Range("H2:H2500" & i).Offset(13 * i, 0).Select 将失败，除非 Sheet2 处于活动状态 .

    但是，您无需激活每个工作表进行复制/粘贴，您可以将代码简化为

    Sub Run()
'
' Run Macro
'

    Dim i As Long

    For i = 1 To 2500
        Sheets("Sheet1").Range("C1:P1").Copy
        Sheets("Sheet2").Range("H2:H2500" & i).Offset(13 * i, 0).PasteSpecial Paste:=x1PasteFormulas, Operation:=x1None, Skipblanks:= _
        False, Transpose:=True

    Next i

End Sub

    BTW， C1:P1 实际上是14个单元格宽，所以你的偏移量应该是14而不是13，因为你每次都会覆盖最后一个单元格 .

    此外， Sheets("Sheet2").Range("H2:H2500" & i) 似乎有一个拼写错误，因为 & i 将导致目标范围每次变大，并且当您粘贴静态范围时，不需要这样做 . 只需使用 Sheets("Sheet2").Range("H2:H14") 就可以逃脱

    回复于

相关问题