CODEWITHSUNDEEP
vbaexcel
Adam
Adam

Reputation: 85

Copy the range and check for duplicates

Dears, I would like to add to the below code, the lines, which do the following:

  1. Copy the range from Results tab and pastes it to every newly created sheet. It should be copied to the same column which is populated by the below macro.

I think we would need to add this code somewhere: 

Worksheets("Results").Range("A1:A65").Copy Destination:=ActiveSheet.Range("a50:a150") ???
  1. It should also check this column for duplicates.

Will you ba able to help?

the initial code is the following:

Sub YouShouldHavePostedAnAttemptFirst()

    Dim c As Range
    Dim CtRows, SheetCtr As Integer
    'Try to put your data on sheet 1 then create a new sheet so that it is the
    'second sheet in the workbook.

    SheetCtr = 4

    CtRows = Application.CountA(Sheets("2nd step").Range("r:r"))

    For Each c In Range(Cells(1, 18), Cells(CtRows, 18))
        c.Offset(, -10).Copy Sheets(SheetCtr).Cells(Rows.Count, "a:a").End(xlUp).Offset(1, 0)

        If c.Offset(1, 0) <> c Then

            Sheets.Add after:=Sheets(ActiveWorkbook.Sheets.Count)
            SheetCtr = SheetCtr + 1

        End If

    Next c

End Sub

Thank you,

Upvotes: 0

Views: 384

Answers (1)

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19737

This code will copy the data from Results into your existing sheets and then create four new sheets and paste the data in there as well: 

Sub PopulateSheets()

    Dim wrkSht As Worksheet
    Dim SheetCtr As Long, x As Long

    'First go through each sheet in the workbook.
    'If you want other sheets apart from 'Results' to be ignored just add them to the Case.
    'e.g. Case "Results", "Sheet1" will ignore Results & Sheet1.
    For Each wrkSht In ThisWorkbook.Worksheets
        Select Case wrkSht.Name
            Case "Results"
                'Do nothing - we're copying from this sheet.
            Case Else
                'Copy from Results to the other worksheet.
                With ThisWorkbook.Worksheets("Results")
                    .Range("A1:A65").Copy Destination:=wrkSht.Range("A50")
                End With
        End Select
    Next wrkSht

    'Creates 4 sheets, copies the data over and moves the sheet to the end.
    SheetCtr = 4
    With ThisWorkbook
        For x = 1 To SheetCtr
            Set wrkSht = ThisWorkbook.Worksheets.Add
            .Worksheets("Results").Range("A1:A65").Copy Destination:=wrkSht.Range("A50")
            wrkSht.Move After:=Sheets(.Sheets.Count)
        Next x
    End With

End Sub

If you just want to copy the data when a new sheet is added -
In a normal module add the below code. The procedure takes a reference to a worksheet and copies the data from the Results sheet to it and removes any duplicates.

Public Sub CopyToNewSheet(sht As Worksheet)

    With sht
        ThisWorkbook.Worksheets("Results").Range("A1:A65").Copy Destination:=.Range("A50")
        .Range("A50:A114").RemoveDuplicates Columns:=1, Header:=xlNo
    End With

End Sub

In the ThisWorkbook module add the below code. This checks that you're adding a worksheet rather than a chart sheet or any other type and passes the sheet reference to the CopyToNewSheet procedure:

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    If Sh.Type = xlWorksheet Then
        CopyToNewSheet Sh
    End If
End Sub

Upvotes: 1

Related Questions