Forum Discussion
Copy table data to new table using VBA Worksheet Change event
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBereich As Range
Set rngBereich = Range("B2:B10000")
Application.EnableEvents = False
If Target.Cells.Count > 1 Then GoTo done
If Not Application.Intersect(Target, rngBereich) Is Nothing Then
If IsDate(Target.Value) And Target.Value <> "" And Target.Offset(0, -1).Value = "To Estimating QC" Then
Sheets("Work Orders").Cells(Target.Row, "C").Copy _
Destination:=Sheets("Estimating Orders").Range("C" & Rows.Count).End(xlUp).Offset(1)
Sheets("Work Orders").Cells(Target.Row, "E").Copy _
Destination:=Sheets("Estimating Orders").Range("E" & Rows.Count).End(xlUp).Offset(1)
Sheets("Work Orders").Cells(Target.Row, "J").Copy _
Destination:=Sheets("Estimating Orders").Range("J" & Rows.Count).End(xlUp).Offset(1)
Sheets("Work Orders").Cells(Target.Row, "L").Copy _
Destination:=Sheets("Estimating Orders").Range("L" & Rows.Count).End(xlUp).Offset(1)
Else
End If
End If
done:
Application.EnableEvents = True
Exit Sub
End Sub
You can try this code. If you enter a date in range B2:B10000 and there is "To Estimating QC" in the adjacent cell in column A the data from columns C, E, J, and L in the same row is added to sheet "Estimating Orders".
Also, one more potential complication - and this may be my ignorance showing - but I already have another sub running in this sheet for an automated email to generate when a completed date is entered. Do I need to run this script in a module, or can you have two subs in the same place?
- OliverScheurichNov 09, 2022Gold Contributor
In the attached file in the "Work Orders" sheet i've converted the table into a dynamic table and the Worksheet_Change event copies the data to the "Estimating Orders" sheet as intended.
If you have two Worksheet_Change events in the same sheet you can combine them into one for example:
This
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBereich As Range
Set rngBereich = Range("A2:A25")
If Not Application.Intersect(Target, rngBereich) Is Nothing Then
If (Target.Value <= 100) And (Target.Value > 0) Then
Target.Offset(0, 1).Value = Date
Else
End IfEnd If
End Sub
and this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBereich As Range
Set rngBereich = Range("B2:B2500")
If Not Application.Intersect(Target, rngBereich) Is Nothing Then
If (Target.Value > 0) Then
Target.Offset(0, 1).Value = "Everything as expected"
Else
End IfEnd If
End Sub
can be combined into:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBereich As Range
Set rngBereich = Range("A2:A25")
If Not Application.Intersect(Target, rngBereich) Is Nothing Then
If (Target.Value <= 100) And (Target.Value > 0) Then
Target.Offset(0, 1).Value = Date
Else
End IfEnd If
Set rngBereich = Range("B2:B2500")
If Not Application.Intersect(Target, rngBereich) Is Nothing Then
If (Target.Value > 0) Then
Target.Offset(0, 1).Value = "Everything as expected"
Else
End IfEnd If
End Sub