Hi, I'm trying to copy/paste values from different columns of the same row when the value in the same row some columns after is met. I'm having problems doing that. Better explained:

I've a range that goes from AS11 to BO80 and in every row I have in column BP the condition that has to be met. That means, when the value 1 is set automatically in a row, the code has to be trigger by itself and ask if you want to generate an unique code for the activites contained in the mentioned row.

When the user click on yes, it has to copy just the row where the condition is met and paste it a a value in another sheet ("ActivityCodes") in vertical mode and not horizontal. Another plus wil be if along the copied rows, the name of the user and the date is pasted in every single row where the value is copied.

A nice to have thing will be that just the columns with values are copied and no empty row in between exist in the sheet ("ActivityCodes").

Also, the other issue is, in this Sheet ("ActivityCodes") there will be copied values of different input sheets.

Do you think you could help me????

Cheers,
Daniel

Sub concentrateCodes()

Dim inputWks As Worksheet
Dim outputWks As Worksheet
Dim r As Long
Dim endRow As Long
Dim pasteRowIndex As Long
Dim FCol As Long
Dim LCol As Long
Dim NRow As Long
Dim Ans As Integer

Application.ScreenUpdating = False

    Set inputWks = ActiveWorkbook.ActiveSheet
    Set outputWks = ActiveWorkbook.Sheets("ActivityCodes")
    
    endRow = inputWks.Range("BP9").Value + 11
    FCol = 45
    LCol = 67
       
    For r = 11 To endRow

        If Cells(r, Columns("BP").Column).Value = 1 Then

                Ans = MsgBox("Task is completed for all Entities and completition codes will be generated.", vbQuestion + vbYesNo, "OK to continue?")
                If Ans = vbYes Then

                inputWks.Range(Cells(r, FCol), Cells(r, LCol)).Select
                Selection.Copy

                outputWks.Select
                NRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                Cells(NRow, 1).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=True, Transpose:=True
                
                With outputWks
                With .Cells(NRow, "B")
                .Value = Now
                .NumberFormat = "mm/dd/yyyy hh:mm:ss"
                End With
          
                .Cells(NRow, "C").Value = Application.UserName
                End With
                
                inputWks.Select
                
                Else
                
                MsgBox "Please review in order to generate them."
                
                End If
        End If
        
    Next r

Application.ScreenUpdating = True

End Sub