Thanks Thanks:  0
Likes Likes:  0
Results 1 to 2 of 2

Thread: Copy Sheets in A Master Sheet

  1. #1
    New Member
    Join Date
    Oct 2018
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default Copy Sheets in A Master Sheet

    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?

    Sub Test()
        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 End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
    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
             MsgBox cell.Value & " is already in Home sheet"
          End If
        Next cell
      End With
    End If End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
    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 End Sub

  2. #2
    MrExcel MVP
    Peter_SSs's Avatar
    Join Date
    May 2005
    Macksville, Australia
    Post Thanks / Like
    78 Post(s)
    16 Thread(s)

    Default Re: Copy Sheets in A Master Sheet

    Welcome to the MrExcel board!

    Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules. Be sure to follow & read the link at the end of the rule too!

    Cross posted at:

    If you do cross-post in the future and also provide a link, then there shouldn’t be a problem.
    Hope this helps, good luck.
    Excel 365 - Windows 10
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts