Copy Sheets in A Master Sheet

pirvuvali

New Member
Joined
Oct 12, 2018
Messages
1
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?

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]
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top