Excel宏根据单元格值将一行中的单元格从一张表复制到另一页 [英] Excel Macro to copy select cells from a row from one sheet to another based upon a cell value

问题描述

我正在尝试使用excel宏执行以下操作。当日期输入到表格1中的单元格时，我想从该行中取出特定单元格，并将其复制到表2中的新行。以下是一个示例。

I'm trying to do the following with an excel macro. When a date is entered into a cell on sheet 1 I want to take specific cells from that row and copy them to a new row on sheet 2. Here is an example.

这将是表1。

A         B            C               D            E
proj1     mary         started         -            fiber
proj2     jack         complete        2/7/2014     fiber  
proj3     kim          started         -            cat6
proj2     phil         complete        2/9/2014     fiber  

表格2应该是这样的，因为他们中有两个有日期，我只想特别提到行A，C和D的单元格。

Sheet 2 should then look like this since two of them have dates and I only want to bring over specifically the cells from row A,C and D.

A         B            C
proj2     complete     2/7/2014
proj2     complete     2/9/2014

使用以下代码，我发现我可以根据单元格中的单词值来覆盖整行，但不能仅仅是特定的当然，我希望它根据输入的日期触发不是回复或回复。任何帮助将不胜感激。

With the following code I found I'm able to bring over an entire row based on a word value in a cell but not just the specific ones I want and of course I want it to trigger based on a date being entered not the words "reply" or "response". Any help would be appreciated.

Sub Foo()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("reply,response", ",")
For Each cell In Sheets("sheet1").Range("D:D")
    If (Len(cell.Value) = 0) Then Exit For
        For i = 0 To UBound(aTokens)
            If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("sheet1").Rows(cell.Row).Copy Sheets("sheet2").Rows(iMatches)
            End If
        Next
Next
End Sub

推荐答案

帮帮我。它需要放在 Worksheet_Change 部分。

This may help. It needs to be placed in the Worksheet_Change section.

这假定你的数据在列$ A：E 在 Sheet1 中，您要将数据复制到 Sheet2 已经输入了一个日期。

This assumes your data is in Columns A:E in Sheet1 and you want to copy data over to Sheet2 once you have entered a date.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nextRow As Long
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        If VBA.IsDate(Target) Then
            With Worksheets("Sheet2")
                nextRow = IIf(VBA.IsEmpty(.Range("A1048576").End(xlUp)), 1, .Range("A1048576").End(xlUp).Row + 1)
                .Range("A" & nextRow) = Target.Offset(0, -3)
                .Range("B" & nextRow) = Target.Offset(0, -1)
                .Range("C" & nextRow) = Target
            End With
        End If
    End If
End Sub

这篇关于Excel宏根据单元格值将一行中的单元格从一张表复制到另一页的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！