如果字段具有X,则将单元格复制到另一个工作表

时间:2012-09-14 04:09:14

标签: excel vba

我有一个Excel跟踪器,如果某个活动完成,我每个月都会在一个单元格中放一个“X”。

此“X”与同一张纸上的一系列单元格相关。

我想点击命令框时;

  1. 如果1月的单元格在当前页面上有一个“X”复制特定单元格到另一个工作表上的特定单元格。
  2. 如果2月的单元格有“X”,则将当前页面上的其他特定单元格复制到另一个工作表上的其他特定单元格。
  3. 等到12月等等。

    我有以下代码(不起作用):

    Private Sub CommandButton1_Click()
    Sheets("MRT").Select
    If InStr(1, (Range("L8").Value), "X") > 0 Then
        Range("E42:AA42").Select
        Selection.Copy
        Sheets("Test '12").Select
        Cells(3, AP).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
    End If
    End Sub
    

1 个答案:

答案 0 :(得分:0)

试试这个:

Private Sub CommandButton1_Click()
 If Sheets("MRT").Range("L8").Value like "*X*" Then

   Sheets("MRT").Range("E42:AA42").Copy
   Sheets("Test '12").Cells(3, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
 End If
End Sub

在我的测试中工作,但是您可能希望将Cells(3,1)和其他位置说明符调整到您想要的目标。

编辑:忘了几个月的部分...等一下......这里:

Sub FindSignificant()
    Dim SearchString As String
    Dim SearchRange As Range, cl As Range
    Dim FirstFound As String
    Dim sh As Worksheet

    ' Set Search value
    SearchString = "a"
    Application.FindFormat.Clear
    ' loop through all sheets
        Set sh = Sheets("MRT")
        ' Find first instance on sheet
        Set cl = sh.Cells.Find(What:=SearchString, _
             After:=sh.Cells(1, 1), _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False)
        If Not cl Is Nothing Then
            ' if found, remember location
            FirstFound = cl.Address
            ' format found cell
            Do
                Select Case sh.Cells(cl.Row, 1).Value
                  Case "december"
                    sh.Range("E42:AA42").Copy
                    Sheets("Test '12").Cells(3, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
                  Case "february"
                    sh.Range("E42:AA42").Copy
                    Sheets("Test '12").Cells(3, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
                  Case Else
                    'do nothing
                End Select

                ' find next instance
                Set cl = sh.Cells.FindNext(After:=cl)
                ' repeat until back where we started
            Loop Until FirstFound = cl.Address
        End If
End Sub

此代码来自here

您必须调整选择案例,但如果没有必要,我真的会考虑在没有VBA的情况下解决这个问题;)