Hi guys!
I have a workbook with 5 sheets and 1 sheets Master. If in column B from Sheets1,2,3,4,5 check x, then in column A will be allocate a unique number in Master. if this number is already in master, cell.clearcontents. and i need to copy all data from sheets 1,2,3,4,5 (A:Z) to master. I have this codes, but how can to combine them?
I have a workbook with 5 sheets and 1 sheets Master. If in column B from Sheets1,2,3,4,5 check x, then in column A will be allocate a unique number in Master. if this number is already in master, cell.clearcontents. and i need to copy all data from sheets 1,2,3,4,5 (A:Z) to master. I have this codes, but how can to combine them?
Code:
[/COLOR][COLOR=#333333]Sub Test()[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;"> Dim ws As Worksheet
Dim cel As Range
Dim r As Long
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> "Master" Then
For Each cel In ws.Range("B1:B" & ws.Cells(Rows.Count, 1).End(xlUp).Row)
If cel.Value = "x" Then
r = r + 1
Sheets("Master").Range("A" & r).Value = cel.Offset(, -1).Value
End If
Next cel
End If
Next ws
Application.ScreenUpdating = True </code>[COLOR=#333333]End Sub[/COLOR][COLOR=#333333]
Code:
[/COLOR][COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">
Dim rng As Range, cell As Range, datarow As Long
Set rng = Intersect(Target, Columns("A:A"))
If Not rng Is Nothing Then
With Sheets("Master")
For Each cell In rng
If WorksheetFunction.CountIf(.Columns("A:A"), cell.Value) = 0 Then
datarow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(datarow, "A") = cell.Value
Else
MsgBox cell.Value & " is already in Home sheet"
cell.ClearContents
End If
Next cell
End With
End If </code>[COLOR=#333333]End Sub[/COLOR][COLOR=#333333]
Code:
[/COLOR][COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Dim maxNumber
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' don't run when more than one row is changed
If Target.Rows.Count > 1 Then Exit Sub
' if column A in the current row has a value, don't run
If Cells(Target.Row, 1) > 0 Then Exit Sub
' get the highest number in column A, then add 1 and write to the
' current row, column A
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = maxNumber + 1
End If </code>[COLOR=#333333]End Sub[/COLOR][COLOR=#333333]