Question

Sub CPRow()

Range("D14:K14").Select
Selection.Copy
Range("D15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 End Sub

我想添加代码来执行以下操作：

1-如果工作表名称以数字开头，则复制范围（D14：K14）并将其粘贴到范围（D15：K15）中作为值。

2-转到下一张纸并执行相同操作，并在没有编号的工作表或者工作表名称以字母开头时停止。

感谢任何帮助。

Answer 1

下面的代码会复制Range("D14:K14")表单Worksheets("Sheet1")（修改＆＃34; Sheet1＆＃34;到您的工作表名称），并将其粘贴到所有工作表中他们的名字以数字开头。

Option Explicit

Sub CPRow()

Dim Sht As Worksheet
Dim ShttoCopy As Worksheet

Set ShttoCopy = Worksheets("Sheet1") ' <-- modify "Sheet1" to the sheet you want to copy Range("D14:K14") from

For Each Sht In ThisWorkbook.Worksheets
    If IsNumeric(Left(Sht.Name, 1)) Then
        ShttoCopy.Range("D14:K14").Copy
        Sht.Range("D15").PasteSpecial xlPasteValues
    End If
Next Sht

End Sub

宏复制粘贴范围

1 个答案: