VBA宏需求：将Sheet1指定区域数据批量粘贴至12个工作表

Got it, let's solve this. You need to replicate the data from Sheet1!A2:D17 into 12 separate worksheets in your workbook. Below are two flexible approaches—pick the one that matches your setup best.

Approach 1: Target Specific Worksheets by Name #

Use this if you know the exact names of your 12 target sheets. Just update the targetSheetNames array with your sheet names:

Sub CopyDataToNamedSheets()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetSheetNames As Variant
    
    ' Define the source sheet and data range
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    Set sourceRange = sourceSheet.Range("A2:D17")
    
    ' List your 12 target worksheet names here
    targetSheetNames = Array("Q1", "Q2", "Q3", "Q4", "Jan", "Feb", _
                            "Mar", "Apr", "May", "Jun", "Jul", "Aug")
    
    ' Loop through each target sheet
    For Each sheetName In targetSheetNames
        Set targetSheet = ThisWorkbook.Worksheets(sheetName)
        
        ' Optional: Clear existing data in the target range (remove if not needed)
        targetSheet.Range("A2:D17").ClearContents
        
        ' Paste data with formatting (uses clipboard)
        sourceRange.Copy
        targetSheet.Range("A2").PasteSpecial Paste:=xlPasteAll
        
        ' Faster alternative (no clipboard, values only):
        ' targetSheet.Range("A2:D17").Value = sourceRange.Value
    Next sheetName
    
    ' Clean up the clipboard
    Application.CutCopyMode = False
    
    MsgBox "Data copied to all target sheets successfully!", vbInformation
End Sub

Approach 2: Target the Next 12 Worksheets (Excluding Sheet1) #

If your 12 target sheets are the first 12 sheets in the workbook right after Sheet1, use this loop—no need to list every sheet name:

Sub CopyDataToNext12Sheets()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim i As Integer
    
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    Set sourceRange = sourceSheet.Range("A2:D17")
    
    ' Loop through sheets 2 to 13 (12 total sheets)
    For i = 2 To 13
        Set targetSheet = ThisWorkbook.Worksheets(i)
        
        ' Optional: Clear old data
        targetSheet.Range("A2:D17").ClearContents
        
        ' Paste with formatting
        sourceRange.Copy
        targetSheet.Range("A2").PasteSpecial Paste:=xlPasteAll
        
        ' Faster values-only option:
        ' targetSheet.Range("A2:D17").Value = sourceRange.Value
    Next i
    
    Application.CutCopyMode = False
    MsgBox "Data replication complete!", vbInformation
End Sub

Quick Setup Guide: #

1. Open your Excel file
2. Press Alt + F11 to launch the VBA Editor
3. Right-click your workbook in the Project Explorer > Insert > Module
4. Paste the code of your chosen approach into the module
5. Adjust the source range, target sheet names, or sheet indices if needed
6. Press F5 to run the macro, or assign it to a button in Excel for one-click access

Pro tip: The direct value assignment (targetSheet.Range(...).Value = sourceRange.Value) is faster than copy-paste because it skips the clipboard. Use that if you don't need to preserve cell formatting—stick with PasteSpecial if formatting matters.

内容的提问来源于stack exchange，提问作者suraj