Copy paste from Sheet1 to Sheet2

Abdulkhadar

Board Regular
Joined
Nov 10, 2013
Messages
114
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

Well-known Member
Joined
Nov 1, 2008
Messages
3,524
If i understand correctly you have in Sheet1 a table. In column AC from row 15 downwards the DOB's are held. If a DOB is 59 or more before 31/03/2021 then columns C,D,E,F,I & AB need to be copied to Sheet2 starting from row 10. Columns C->B, D->C, E->D, F->E, I->G and AB->F

Is that correct? Or is it ONLY row 15 to row 10?
 

Abdulkhadar

Board Regular
Joined
Nov 10, 2013
Messages
114
If i understand correctly you have in Sheet1 a table. In column AC from row 15 downwards the DOB's are held. If a DOB is 59 or more before 31/03/2021 then columns C,D,E,F,I & AB need to be copied to Sheet2 starting from row 10. Columns C->B, D->C, E->D, F->E, I->G and AB->F
This is correct.
I want to copy in Sheet2 from B10 cell.
 

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,524
OK Try this code. Run it on a copy of the workbook first. Read the comments in the code and act on the ones with <<< in front if necessary

VBA Code:
Option Explicit

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
    
    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
        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
    Next lRi
    
    'Now dump the output to the bottom of the list on sheet 2
    Set rOut = wsOut.Range("B10")
    If rOut.Offset(1, 0) <> "" Then
        Set rOut = rOut.End(xlDown).Offset(1, 0)
    End If
    rOut.Resize(UB, 6).Value = vOutp
    
    
    'clean up
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set rOut = Nothing
End Sub
 

Abdulkhadar

Board Regular
Joined
Nov 10, 2013
Messages
114
OK Try this code. Run it on a copy of the workbook first. Read the comments in the code and act on the ones with <<< in front if necessary

VBA Code:
Option Explicit
Wow nice work Sir. Thanks a lot.
one more request. I want to clear the data of col B to Col G of Sheet2 before run the macro.
Thanks once again.
 

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,524
OK, I understood you wanted to add to the list. Makes for even easier code:

VBA Code:
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
   
    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
        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
    Next lRi
   
    'Now dump the output to B10 on sheet 2
    Set rOut = wsOut.Range("B10")
    rOut.Resize(UB, 6).Value = vOutp
   
   
    'clean up
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set rOut = Nothing
End Sub
 

Abdulkhadar

Board Regular
Joined
Nov 10, 2013
Messages
114
OK, I understood you wanted to add to the list. Makes for even easier code:

VBA Code:
Sub CopyColmnsOver59()
Thanks once again.
When I protect the Sheet1 except C, D, E, F, I, AB and AC columns macro shows error as

"Can't execute code in break mode"

With wsIn.Range("C15").CurrentRegion

is it possible to run a macro when protected mode.
 

sijpie

Well-known Member
Joined
Nov 1, 2008
Messages
3,524
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
VBA Code:
Sub SheetProtection(wsWS As Worksheet, bOn As Boolean)
    
    Select Case bOn
        Case True   'switch on
            wsWS.Protect Password:=""
        Case False   'switch off
            wsWS.Unprotect Password:=""
    End Select
End Sub
Then the CopyColmnsOver59 macro needs to be changed as follows:
VBA Code:
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
        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
    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

Board Regular
Joined
Nov 10, 2013
Messages
114
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
VBA Code:
Very Nice sir.
Thanks a lot for your patience. Have a nice day.
 

Forum statistics

Threads
1,078,435
Messages
5,340,255
Members
399,361
Latest member
Linford

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top