使用 vba 在工作表数组中复制并粘贴特定单元格（使用 .find）

Question

下面的代码根据选项卡的颜色选择选项卡。每个 sheet 的格式相同，只是包含不同的值。我正在尝试使用 .find 和 offset 来查找特定的单元格（它对应于当前财政周加上一个），然后将该单元格复制并粘贴为值而不是公式。下面的代码选择所需的选项卡并找到正确的单元格，但不会将该单元格复制并粘贴为值。我试图不具体命名 sheets，因为此代码将用于多个工作簿，所有工作簿都具有不同的选项卡名称。

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

谢谢

Answer 1

你不能这样做：

Sheets(strg(1)).aCell.Select

sheet 已存储在范围对象 aCell 中。您也不应该使用 select 并且不需要粘贴该值。这是我会做的：

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 选项，如果应用于工作sheets 以扩展当前的 selection，抱歉那个！

Answer 2

更新 #2（周日 11:15 美国东部时间）添加了调试语句来帮助您；需要在 'Find' 中添加对 'ActiveSheet' 的引用代码将遍历所有 'Red' 工作表，找到匹配项（如果有）和 copy/paste 值。调试代码将显示红色标签名称、搜索值、结果、公式、值

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

使用 vba 在工作表数组中复制并粘贴特定单元格（使用 .find）

copy and paste specific cell(using .find) in worksheet array using vba

arrays

excel

vba

copy-paste