macro for special copy / paste

M

MSchädler

Board Regular
Joined
Apr 27, 2017
Messages
95
Hello and I need some help with defining a macro to do the following.

My excel file has 2 register; "export" and "archive".
At the end of each month I want to copy each line entry from register "export" that has a date stamp within that month and paste it into the register "archive" below the last entry. The challenge is that the copy/paste is a matrix (see below).
At the end of the macro I want to delete the copied data from the register "export" that has the date stamp within that month.


The actual month is defined with the data in cell "A30" in register "export".
There is an active-x button in register "export" that when "clicked" will run the macro.
This macro should do the following: each line in register "export" that has the date in column "E" that is within the month (eg. 01.11.-30.11.2017), it should copy each cell and paste each cell in register "archive* below the last entry. Each cell of the copied line will be pasted in a different column in the register "archive". The copy/paste matrix should be as follow:

  • copy from register "export" column "A" and paste in register "archive" below last entry in column "A"
  • copy from register "export" column "B" and paste in register "archive" below last entry in column "I"
  • copy from register "export" column "C" and paste in register "archive" below last entry in column "H"
  • copy from register "export" column "D" and paste in register "archive" below last entry in column "D"
  • copy from register "export" column "E" and paste in register "archive" below last entry in column "B"
  • copy from register "export" column "F" and paste in register "archive" below last entry in column "J"
  • copy from register "export" column "G" and paste in register "archive" below last entry in column "G"
  • copy from register "export" column "H" and paste in register "archive" below last entry in column "E"
  • copy from register "export" column "I" and paste in register "archive" below last entry in column "C"
  • copy from register "export" column "J" and paste in register "archive" below last entry in column "F"

Set up in register "export"
[TABLE="width: 600"]
<tbody>[TR]
[TD][TABLE="width: 600"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]State[/TD]
[TD]Typ[/TD]
[TD]Case1[/TD]
[TD]Case2[/TD]
[TD]Date[/TD]
[TD]Entry1[/TD]
[TD]Entry2[/TD]
[TD]Entry3[/TD]
[TD]Type[/TD]
[TD]Net[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]test1[/TD]
[TD]test2[/TD]
[TD]test3[/TD]
[TD]test4[/TD]
[TD="align: right"]30.11.2017[/TD]
[TD]test5[/TD]
[TD]test6[/TD]
[TD]test7[/TD]
[TD]test8[/TD]
[TD]test9[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Set up in register "archive"
[TABLE="width: 557"]
<tbody>[TR]
[TD][TABLE="width: 557"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[/TR]
[TR]
[TD]State[/TD]
[TD]Date[/TD]
[TD]Entry1[/TD]
[TD]Case2[/TD]
[TD]Type[/TD]
[TD]Net[/TD]
[TD]Entry2[/TD]
[TD]Case1[/TD]
[TD]Typ[/TD]
[TD]Entry3[/TD]
[/TR]
[TR]
[TD]test1[/TD]
[TD="align: right"]30.11.2017[/TD]
[TD]test8[/TD]
[TD]test4[/TD]
[TD]test7[/TD]
[TD]test9[/TD]
[TD]test6[/TD]
[TD]test3[/TD]
[TD]test2[/TD]
[TD]test5[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Thank you for your help with this macro. Kind regards, Marc
 
Last edited:
Sort by date Sort by votes
Re: Help needed for vba-code (macro) for special copy / paste

"My Answer Is This" thanks for your code.
Alternative codes is always good, especially for me, so I can learn.

MSchädler.. try this,

Code: 
[COLOR=#0000cd]Sub Schaltfläche1_Klicken()
[/COLOR][COLOR=#d3d3d3]'
'based on code by Fluff - MrExcel MVP
'by lhartono
'Function UpdateArchive()[/COLOR][COLOR=#0000cd]

    Dim WorkRng1 As Range, Rng1 As Range
    Dim StartTime       As Double
    Dim MinutesElapsed  As String
    Dim intMonth        As Integer
    Dim rowLast         As Long
    Dim arrExport       As Variant
    Dim strExport       As String
    Dim strArchive      As String
    
    StartTime = Timer
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    strExport = "Aus UBSExport"
    strArchive = "Archiv Alt"
    
    intMonth = Month(Sheets(strExport).Range("A30").Value)
    
    Set WorkRng1 = Sheets(strExport).Range("E2:E" & (Sheets(strExport).Range("E" & Rows.Count).End(xlUp).Row))

    For Each Rng1 In WorkRng1
        If (Not IsEmpty(Rng1.Value)) And (Len(Trim(Rng1.Value)) > 0) And IsDate(Rng1.Value) Then
            If Month(Rng1.Value) = intMonth Then
                arrExport = Sheets(strExport).Range("A" & Rng1.Row & ":" & "J" & Rng1.Row)
                rowLast = Sheets(strArchive).Range("D" & Rows.Count).End(xlUp).Row + 1
                With Sheets(strArchive)
                    .Range("A" & rowLast).Value2 = arrExport(1, 1)  'A
                    .Range("B" & rowLast).Value2 = arrExport(1, 5)  'E
                    .Range("C" & rowLast).Value2 = arrExport(1, 9)  'I
                    .Range("D" & rowLast).Value2 = arrExport(1, 4)  'D
                    .Range("E" & rowLast).Value2 = arrExport(1, 8)  'H
                    .Range("F" & rowLast).Value2 = arrExport(1, 10) 'J
                    .Range("G" & rowLast).Value2 = arrExport(1, 7)  'G
                    .Range("H" & rowLast).Value2 = arrExport(1, 3)  'C
                    .Range("I" & rowLast).Value2 = arrExport(1, 2)  'B
                    .Range("J" & rowLast).Value2 = arrExport(1, 6)  'F
                End With
                Erase arrExport
                Sheets(strExport).Range("A" & Rng1.Row & ":" & "J" & Rng1.Row).ClearContents
            End If
        End If
    Next Rng1

    With ActiveWorkbook.Worksheets(strExport).Sort
        .SortFields.Add Key:=Range("E2:E22"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:J22")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Set Rng1 = Nothing
    Set WorkRng1 = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
    Debug.Print "The Code Took " & MinutesElapsed & " (hh:mm:ss) To Run"

End Sub[/COLOR]
 
Upvote 0

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Re: Help needed for vba-code (macro) for special copy / paste

Hello Ihartono
Wonderful, the script seems to work fine. I will do a couple more tests, but for the moment it does what I want and it looks great.
If you dont't hear from me, everything is fine and I thank you for your effort.

Otherwise I will contact you again.
Kind regards, Marc
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Macro copy text above
Replies
1
Views
134
Kaper
Kaper
B
  • Question Question
VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area
Replies
0
Views
85
brentcole
B
R
  • Solved
Macro to copy variable length table and paste numerous times in the same sheet
Replies
9
Views
242
rynardc
R
R
  • Question Question
Copy paste special change in macro
Replies
5
Views
401
Rhodie72
Rhodie72
O
  • Solved
copy paste macro
Replies
1
Views
528
orsm6
O

Forum statistics

Threads
1,223,648
Messages
6,173,555
Members
452,520
Latest member
Pingaware

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