使用vba复制和粘贴工作表数组中的特定单元格（使用.find）
下面的代码根据选项卡的颜色select选项卡。 每张纸的格式都一样，只是包含不同的值。 我正在尝试使用.find和offset来查找特定的单元格（它与当前会计周加1相对应），然后将该单元格复制并粘贴为值而不是公式。 下面的代码select需要的选项卡并find正确的单元格，但不会将该单元格复制并粘贴为值。 我试图不具体命名工作表，因为这个代码将在多个工作簿上使用不同的选项卡名称。
Sub freeze() Dim ws As Worksheet Dim strg() As String Dim count As Integer count = 1 For Each ws In Worksheets If ws.Tab.Color = 255 Then ReDim Preserve strg(count) As String strg(count) = ws.Name count = count + 1 Else End If Next ws Sheets(strg(1)).Select Dim aCell As Range Set aCell = Range("B9:B79").Find(What:=Worksheets("EmailTemplate").Range("A1").Value) If Not aCell Is Nothing Then Sheets(strg(1)).aCell.Select ActiveCell.Offset(0, 6).Select Selection.copy Selection.PasteSpecial xlPasteValues Else End If For I = 2 To UBound(strg) Sheets(strg(I)).Select False Next I End Sub 谢谢
更新＃2（美国东部时间11：15）增加了debugging语句来帮助您; 需要在“查找”代码中添加对“ActiveSheet”的引用将遍历所有“红色”表，find匹配（如果有）和复制/粘贴值。 debugging代码将显示红色选项卡名称，search值，结果，公式，值
Option Explicit Sub freeze() Dim ws As Worksheet Dim aCell As Range Dim strg() As String Dim count As Integer Dim i As Integer count = 0 ' Get each RED sheet For Each ws In Worksheets If ws.Tab.Color = 255 Then ' Find only RED tabs Debug.Print "-----------------------------------------------------------------------" Debug.Print "Name of Red Sheet: '" & ws.Name & "'" ' Debug... 'ReDim Preserve strg(count + 1) As String 'count = count + 1 ' This code not necessary as you can just reference the ws.name 'strg(count) = ws.Name ' Ditto Sheets(ws.Name).Select Set aCell = ActiveSheet.Range("B9:B79").Find(What:=Worksheets("EmailTemplate").Range("A1").value) If Not aCell Is Nothing Then ActiveSheet.Cells(aCell.Row, aCell.column).Select ActiveCell.Offset(0, 6).Select ' Offset same row, + 6 columns Debug.Print "Found Match for '" & Worksheets("EmailTemplate").Range("A1").value & _ "' in: R" & aCell.Row & ":C" & aCell.column & vbTab & "Formula: '" & ActiveCell.Formula & "'; Value: '" & ActiveCell.value & "'" ' Weird, but was unable to use 'aCell.Select' 2nd time thru loop Selection.Copy Selection.PasteSpecial xlPasteValues Else Debug.Print "Did NOT find a match for: '" & Worksheets("EmailTemplate").Range("A1").value & "' in sheet '" & ws.Name & "'" End If Application.CutCopyMode = False ' Unselect cell End If Next ws End Sub
你不能这样做：
Sheets(strg(1)).aCell.Select
工作表已存储在范围对象aCell 。 你也不应该使用select和pasteing这个值是没有必要的。 这是我会做的：
Dim aCell As Range Set aCell = Sheets(strg(1)).Range("B9:B79").Find(What:=Worksheets("EmailTemplate").Range("A1").Value) If Not aCell Is Nothing Then aCell.Offset(0, 6).Value = aCell.Offset(0, 6).Value End If
我不明白你想用第二个循环实现什么。 .Select不接受我认为的论据？ 编辑 ：其实.Select接受replace选项，如果应用到工作表来扩展当前的select，对此感到抱歉！