将一系列数据复制到工作簿的所有工作表

时间:2015-11-16 08:52:43

标签: excel vba excel-vba

我有一个包含数据库的工作簿。

在该数据库上,我想要复制并粘贴到所有工作表的某一行数据。

复制范围随数据库中的行数据的变化而变化,但每个位置的粘贴范围保持不变。

我有一个代码,我到目前为止,但它只允许逐页复制粘贴,我无法在代码中定义固定范围。

在这种情况下,我希望将所选数据粘贴到每张纸的B1:N1。

将一个目标粘贴到所有工作表上需要一些帮助。

这是我的代码:

Dim rng As Range, inp As Range
Set rng = Nothing
Set inp = Selection
inp.Interior.ColorIndex = 37
On Error Resume Next
Set rng = Application.InputBox("Copy to", Type:=8)
On Error GoTo 0
If TypeName(rng) <> "Range" Then
    MsgBox "Cancelled", vbInformation
    Exit Sub
Else
    rng.Parent.Activate
    rng.Select
    inp.Copy
    Worksheets("Sheet2").Paste Link:=True
End If

Application.CutCopyMode = 0

2 个答案:

答案 0 :(得分:2)

您是否需要为所有工作表提供循环?

    Dim ws as Worksheet
    For Each ws in ActiveWorkbook.Worksheets
        If Not ws.Name = "*Name of the database workbook *" Then    
            Call ws.Range("B1:N1").PasteSpecial(xlPasteAll, xlPasteSpecialOperationNone)
        End If
    Next

答案 1 :(得分:2)

Dim Rng As Range, _
    Inp As Range, _
    wS As Worksheet

Set Inp = Selection
Inp.Interior.ColorIndex = 37
On Error Resume Next
Set Rng = Application.InputBox("Copy to", Type:=8)
On Error GoTo 0
If TypeName(Rng) <> "Range" Then
    MsgBox "Cancelled", vbInformation
    Exit Sub
Else
    Rng.Parent.Activate
    Inp.Copy

    For Each wS In ActiveWorkbook.Worksheets
        wS.Range("B1").Paste Link:=True
    Next
End If

Application.CutCopyMode = 0