Copy paste from Sheet1 to Sheet2

A

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

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
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
sijpie said:
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
Click to expand...
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
sijpie said:
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
Click to expand...
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
sijpie said:
OK, I understood you wanted to add to the list. Makes for even easier code:

VBA Code: 
Sub CopyColmnsOver59()
Click to expand...
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
sijpie said:
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:
Click to expand...
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

sijpie said:
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]
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question Question
copy from source sheet1 to destination sheet2 vba code
Replies
1
Views
252
Vishaal
V
R
  • Question Question
VBA Check if value in Sheet1 exists in Sheet2 then copy specific cells from Sheet2 into Sheet1
2
Replies
13
Views
2K
dermie_72
D
P
  • Question Question
Removing duplicates from sheet2 and paste data in sheet1, got issues
2
Replies
16
Views
423
mumps
mumps
S
  • Question Question
Macro to Copy Values from Non-Contiguous Cells (Column) to Contiguous Cells (Rows)
Replies
3
Views
110
mumps
mumps
A
  • Solved
Extract the require data from Sheet1 to Sheet2 (Total Consumption For an Item for a period in Sheet1 For Several Items) in another sheet2 get in deta
2
Replies
10
Views
224
DanteAmor
DanteAmor

Forum statistics

Threads
1,224,745
Messages
6,180,700
Members
452,994
Latest member
Janick

Share this page

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