Question

我在几个不同的网站上研究过这个问题，没有明确的方法来做我想要的事情：

我有一个电子表格，其中包含从'B'到'EG'的68对列和'A'中的一个前导数据列。我想创建一个新工作表，并为每对列的第一列的标题命名，然后将'A'中的数据列和一对列复制到新工作表中，并对每个后续对执行相同的操作列。我可以从现有的电子表格数据创建新工作表，但不知道如何命名新工作表以匹配标题字段。

以下代码将创建一个新的工作表并复制数据，但它不会命名工作表，我必须为每个后续的一对列创建68个单独的块！任何人都可以建议代码的mod来遍历列并做我想要的吗？生成的代码如下！任何真正的帮助将非常感激。

谢谢Mike

代码：

Sub testcopy()

 testcopy Macro

 Keyboard Shortcut: Ctrl+f

    Range("A5:A17,B5:B17,C5:C17").Select
    Range("C5").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select

    Range("A5:A17,D5:D17,E5:E17").Select
    Range("E5").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
.
.
.
End Sub

Answer 1

这样的事情：

Sub testcopy()

Dim shtSrc As Worksheet, sht As Worksheet
Dim i As Long, rngA As Range, rngTwo As Range

Set rngA = ActiveSheet.Range("A5:A17")
Set rngTwo = ActiveSheet.Range("B5:C17")

    For i = 1 To 68

        Set sht = Sheets.Add(After:=Sheets(Sheets.Count))
        sht.Name = rngTwo.Cells(1).Value

        Application.Union(rngA, rngTwo).Copy
        sht.Range("A5").PasteSpecial Paste:=xlPasteValues

        Set rngTwo = rngTwo.Offset(0, 2)

    Next i

End Sub

如何循环遍历代码块并在非连续列上操作？

1 个答案: