Copy paste from Sheet1 to Sheet2

[Abdulkhadar]

Dear Excel Experts,

I have a Data in Sheet1, I want to copy some columns to Sheet2 as per below condition.

In Sheet1 from cell AC15 Employees Date of Birth, I want to copy columns C, D, E, F, I and AB from 15th row and paste to Sheet2 of column B, C, D, E, G, And F respectively to 10th row if age is greater than or equal to 59 years as on 31/03/2021. (Column AB of Sheet1 and Column G of Sheet2 is date format i.e., dd/mm/yyyy). without effecting other columns of Sheet2.

Thanks in advance.

 

[sijpie]

Please post your question in a new thread. Then let me know the thread number.

 

[Abdulkhadar]

Macros sure run in protected mode, but not everything can be done.

The solution is very simple though: at the start of the macro unprotect the sheet, then at the end protect the sheet. Add the following code to the code module

Sub SheetProtection(wsWS As Worksheet, bOn As Boolean)

Hi Sir,

I want to small changes in your above VB. If the column AC cell is empty it is considered as 00/01/1900 so do not copy rows if the column AC cells are empty.

Thanks in advance

 

[sijpie]

I have added one line wich checks if the value isn't empty:

Sub CopyColmnsOver59()
    Dim vInp As Variant, vOutp As Variant
    Dim lRi As Long, lRo As Long, UB As Long
    Dim wsIn As Worksheet, wsOut As Worksheet
    Dim rOut As Range
    Dim dDate59 As Date, dDOB59 As Date
   
    Set wsIn = Sheets("Sheet1") '<<< modify if different name
    Set wsOut = Sheets("Sheet2") '<<< modify if different name
   
    ' unprotect the sheets
    SheetProtection wsIn, False
    SheetProtection wsOut, False

    
    dDate59 = CDate("31/03/2021")   '<<< modify this if the date needs changing
    'Read input range into array for fast processing
    'get number of rows to copy
    With wsIn.Range("C15").CurrentRegion
        lRi = .Rows.Count - (15 - .Row)
        'read into array
        vInp = Range("C15").Resize(lRi, 27).Value   'columns C - AC
    End With
   
    'get number of rows
    UB = UBound(vInp, 1)
   
    'create output array
    ReDim vOutp(1 To UB, 1 To 6)
   
   
    'Now process the data
    For lRi = 1 To UB
        if not Isempty(vInp(lRi,27)) then
            dDOB59 = vInp(lRi, 27)
            dDOB59 = DateSerial(Year(dDOB59) + 59, Month(dDOB59), Day(dDOB59))
            If dDate59 >= dDOB59 Then
            Debug.Print dDOB59
                'copy the data to output
                lRo = lRo + 1
                vOutp(lRo, 1) = vInp(lRi, 1) 'C -> B
                vOutp(lRo, 2) = vInp(lRi, 2) 'D -> C
                vOutp(lRo, 3) = vInp(lRi, 3) 'E -> D
                vOutp(lRo, 4) = vInp(lRi, 4) 'F -> E
                vOutp(lRo, 5) = vInp(lRi, 26) 'AB -> F
                vOutp(lRo, 6) = vInp(lRi, 7) 'I -> G
             End If
         End If
    Next lRi
   
    'Now dump the output to B10 on sheet 2
    Set rOut = wsOut.Range("B10")
    rOut.Resize(UB, 6).Value = vOutp

    ' protect the sheets
    SheetProtection wsIn, True
    SheetProtection wsOut, True
   
   
    'clean up
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set rOut = Nothing
End Sub

 

[Abdulkhadar]

I have added one line which checks if the value isn't empty:

[/QUOTE]

Thanks once again sir, Have a nice day