Excel宏將數據驗證僅從[模板]工作表複製到其他幾個工作表

Question

我正在使用Excel，並希望根據單元格地址（例如A3）獲取表格的名稱，此單元格不會移動。我如何去在Excel的VBA中說明這一點？

我的計劃是讓代碼將數據驗證從「維護」選項卡上的一行表中的一行復制到工作簿的每個選項卡上的單個表（減去我的「TOC」和「數據」選項卡）。每個選項卡都是「TEMPLATE」工作表的副本（減去「TOC」，「數據」，「TEMPLATE（維護）」工作表）&。工作表「數據」，「模板」和「模板（維護）」可以隱藏，也可以不隱藏。

編輯：我想着手做這個：

1. 複製的數據驗證在目標工作表中的「模板（MAINT）」工作表
2. 檢查C3，發現它是什麼桌子拆開的;單元格C3是最左上角的單元格，它是一個標題
3. 將數據驗證複製到步驟2中找到的表格中的每個數據行。
4. 重複步驟2和3，直到所有工作表都有將驗證複製到（減去「TOC」，「data」，&「模板（維護）」工作表）。

我在我的「Copy_Data_Validations」子代碼如下：

Dim TotalSheets As Integer 
Dim p As Integer 
Dim iAnswer As VbMsgBoxResult 

With Application 
    .DisplayAlerts = False 
    .ScreenUpdating = False 
End With 

' 
' Move sheet "TOC" to the begining of the workbook. 
' 
Sheets("TOC").Move Before:=Sheets(1) 
' 
' Move sheet "data" to be the second sheet in the workbook. 
' 
Sheets("data").Move Before:=Sheets(2) 

iAnswer = MsgBox("You are about to copy data validations!", vbOKCancel + vbExclamation _ 
+ vbDefaultButton2 + vbMsgBoxSetForeground, "Copying Data Valadations") 
For TotalSheets = 1 To Sheets.Count 
    For p = 3 To Sheets.Count - 2 
' 
' If the answer is Yes, then copy data validations from "TEMPLATE (Maint.) to all other. 
' sheets minus the "TOC" sheet and the "data" sheet. 
' 
     If iAnswer = vbYes Then 
      If UCase$(Sheets(p).Name) <> "TOC" And UCase$(Sheets(p).Name) <> "data" Then 

       ' This chunk of code should copy only the data validations 
       ' of "Table1_1" (A4:AO4) from the maintenance tab to all 
       ' rows of a single table on each worksheet (minus the 
       ' "TOC", "data", & the "TEMPLATE (Maint.)" worksheets. 
       ' This is the section of code I am looking for unless 
       ' someone has something better they can come up with. 

       Selection.PasteSpecial Paste:=xlPasteValidation, _ 
       Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
      End If 
' 
' If the answer is Cancel, then cancels. 
' 
     ElseIf iAnswer = vbCancel Then 
     ' Add an exit here. 
     End If 

With Application 
    .DisplayAlerts = True 
    .ScreenUpdating = True 
End With 

Answer 1

Sub test() 

Dim ws As Worksheet 

With Application 
    .DisplayAlerts = False 
    .ScreenUpdating = False 
End With 

For Each ws In ThisWorkbook.Worksheets 
    If ws.Name <> "TOI" And ws.Name <> "DATA" And ws.Name <> "TEMPLATE (Maint.)" Then 
     Sheets("TEMPLATE (Maint.)").Select 
     Range("Table1").Select 
     Selection.Copy 
     ws.Select 
     Range("A1").Select 
     Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _ 
      SkipBlanks:=False, Transpose:=False 
    End If 
Next 
With Application 
    .DisplayAlerts = True 
    .ScreenUpdating = True 
End With 

End Sub