需要一个宏来根据单元格中的数据将特定单元格从一个工作表中的一行复制到另一个工作表中的特定单元格
Need a macro to copy specific cells from a row in one worksheet to a specific cells in another worksheet base upon a data in the cell
我正在为我的企业制作工作簿。
想要一个宏来将数据从一个工作表的一行中的几个单元格(从 C 到 G 的单元格)复制到另一个工作表行(单元格 A、B、C、F、G)。
要注意的是,只有在 D 列输入了数据时才需要传输它们。
我无法正确使用 Alex P 为类似问题编写的代码:
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
试试这个。我得到了这份工作sheet:
sheet1
sheet2
应用以下代码:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nextRow As Long
If Not Intersect(Target, Range("D:D")) Is Nothing Then
If Not VBA.IsEmpty(Target) Or VBA.IsNull(Target) Then
With Worksheets("Sheet2")
nextRow = IIf(VBA.IsEmpty(.Range("B1048576").End(xlUp)), 1, .Range("B1048576").End(xlUp).Row + 1)
.Range("A" & nextRow) = Target.Offset(0, -1)
.Range("B" & nextRow) = Target
.Range("C" & nextRow) = Target.Offset(0, 1)
.Range("F" & nextRow) = Target.Offset(0, 2)
.Range("G" & nextRow) = Target.Offset(0, 3)
End With
End If
End If
End Sub
尝试在 sheet 1
处输入新行
结果在 sheet 2
您需要注意的是:确保 sheet 1 的 D 列是要输入的最后一项,如果您先输入它,将复制空行。
我正在为我的企业制作工作簿。
想要一个宏来将数据从一个工作表的一行中的几个单元格(从 C 到 G 的单元格)复制到另一个工作表行(单元格 A、B、C、F、G)。
要注意的是,只有在 D 列输入了数据时才需要传输它们。
我无法正确使用 Alex P 为类似问题编写的代码:
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
试试这个。我得到了这份工作sheet:
sheet1
sheet2
应用以下代码:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nextRow As Long
If Not Intersect(Target, Range("D:D")) Is Nothing Then
If Not VBA.IsEmpty(Target) Or VBA.IsNull(Target) Then
With Worksheets("Sheet2")
nextRow = IIf(VBA.IsEmpty(.Range("B1048576").End(xlUp)), 1, .Range("B1048576").End(xlUp).Row + 1)
.Range("A" & nextRow) = Target.Offset(0, -1)
.Range("B" & nextRow) = Target
.Range("C" & nextRow) = Target.Offset(0, 1)
.Range("F" & nextRow) = Target.Offset(0, 2)
.Range("G" & nextRow) = Target.Offset(0, 3)
End With
End If
End If
End Sub
尝试在 sheet 1
处输入新行
结果在 sheet 2
您需要注意的是:确保 sheet 1 的 D 列是要输入的最后一项,如果您先输入它,将复制空行。