Copy paste from Sheet1 to Sheet2

Abdulkhadar

Board Regular
Joined
Nov 10, 2013
Messages
165
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
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.
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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?
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
Hello Sir,
I want to run beolw macro in protected mode.


Sub Prog_Button2_Click()
Dim i As Picture
Dim j As String
On Error Resume Next
If Target.Address = Range("c3").Address Then

'ActiveSheet.Pictures.Delete (here i want a code to delete only k2 cell contains already captured pictures)

j = "C:\Users\CSSHS CKD\Dropbox\Photo\" & Range("c3") & Value & ".jpg"
With Range("k25")
Set i = ActiveSheet.Pictures.Insert(j)
i.Height = 100
i.Weight = 95
i.Top = .Top
i.Left = .Left
i.Placement = xlMoveAndSize
End With
End If
Sheets("Prog").PrintOut
End Sub

Thanks with regards

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



[/code]
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,255
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top