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:

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
Re: Help needed for vba-code (macro) for special copy / paste

Try this:

You will note I have provided three choices.
Copy all row with thismonth in column "E"
Copy all row with lastmonth in column "E"
Copy all row with nextmonth in column "E"

I was not able to figure out how to filter using date in Range("A30")

Remove the ' from in front of line of code to get this line of code to work
Only have one line of code with ' removed

Now it is set to ThisMonth
Any time you see a ' in front of line of code understand this line of code will not run.
Normally it's only for putting in comments.





Code: 
Sub Filter_Me()
Application.ScreenUpdating = False
'Modified 11-30-17 8:05 EST
    With ActiveSheet.Range(Cells(1, "E"), Cells(Cells(Rows.Count, "E").End(xlUp).Row, "E"))
        
        'This Month
        .AutoFilter Field:=1, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
        'Next Month
        '.AutoFilter Field:=1, Criteria1:=xlFilterNextMonth, Operator:=xlFilterDynamic
        'LastMonth
        '.AutoFilter Field:=1, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic
        .Offset(0, -4).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 1)
        .Offset(0, -3).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 9)
        .Offset(0, -2).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 8)
        .Offset(0, -1).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 4)
        .Offset(0, 0).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 2)
        .Offset(0, 1).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 10)
        .Offset(0, 2).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 7)
        .Offset(0, 3).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 5)
        .Offset(0, 4).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 3)
        .Offset(0, 5).SpecialCells(xlCellTypeVisible).Copy Sheets("archive").Cells(1, 6)
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

<strike></strike>
 
Upvote 0
Re: Help needed for vba-code (macro) for special copy / paste

Try this (adjust the range address)...

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

    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 hashSet         As Object
    Dim strDelete       As String
    
    StartTime = Timer
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    intMonth = 1  [/COLOR][COLOR=#a9a9a9]'Sheets("export").Range("A30")[/COLOR][COLOR=#0000cd]
    
    Set WorkRng1 = Sheets("export").Range("E2:E" & (Sheets("export").Range("E" & Rows.Count).End(xlUp).Row))
    Set hashSet = CreateObject("Scripting.Dictionary")

    For Each Rng1 In WorkRng1
        If Month(Rng1.Value2) = intMonth Then
            hashSet.Add key:=Rng1.Value, Item:=Rng1.Address
        End If
    Next Rng1
    
    If hashSet.Count > 0 Then
        For Each Rng1 In WorkRng1
            If hashSet.Exists(key:=Rng1.Value) Then
                arrExport = Sheets("export").Range("A" & Rng1.Row & ":" & "J" & Rng1.Row)
                rowLast = Sheets("archive").Range("D" & Rows.Count).End(xlUp).Row + 1
                With Sheets("archive")
                    .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
            End If
        Next Rng1
        
        For Each Rng1 In WorkRng1
            If hashSet.Exists(key:=Rng1.Value) Then
                strDelete = strDelete & (Rng1.Row & ":" & Rng1.Row) & ","
            End If
        Next
        
        If (Right(strDelete, 1)) = "," Then
            strDelete = Left(strDelete, Len(strDelete) - 1)
        End If
        
[/COLOR][COLOR=#a9a9a9]       'Sheets("export").Range(strDelete).Select[/COLOR][COLOR=#0000cd]
        Sheets("export").Range(strDelete).Delete Shift:=xlUp
        Sheets("export").Range("A2").Select
    End If
    
    hashSet.RemoveAll
    Set hashSet = Nothing
    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 Function[/COLOR]
 
Upvote 0
Re: Help needed for vba-code (macro) for special copy / paste

Hi there. I will test your macro an get back to you later.
Thanks for now:)
Marc
 
Upvote 0
Re: Help needed for vba-code (macro) for special copy / paste

Hello Ihartono, i will test your macro and get back to you with the result.
In the meantime, thanks:)
Marc
 
Upvote 0
Re: Help needed for vba-code (macro) for special copy / paste

And what was wrong with the script I provided in Post 2
 
Upvote 0
Upvote 0
Re: Help needed for vba-code (macro) for special copy / paste

If your dates in column "E" are for November and you use the line of code that says:
LastMonth since this is now December then the script should do what you want.
What is the script doing??



MSchädler said:
Hi there, I prepared a test file https://www.dropbox.com/s/eyvb3mebye4xzra/Test2.xlsm?dl=0

As you can see, it does not take the dates within the month November (30.11.2017).
I'll be doing some more tests. but maybe you have some more ideas.

Thanks, Marc
Click to expand...
 
Upvote 0
Re: Help needed for vba-code (macro) for special copy / paste

My Aswer Is This said:
If your dates in column "E" are for November and you use the line of code that says:
LastMonth since this is now December then the script should do what you want.
What is the script doing??
Click to expand...

Sorry, I guess I didn't read your first instruction correctly. With your input and using "LastMonth" script with the date of 30.11.2017, the correct dates are copied and pasted in the proper sheet.
Now there is only the issue of pasting each value at the end of that column in that table. I want to add each month entry to that sheet.
I'm doing a few more tests. If you happen to find a solution for this, let me know.

In the meantime thanks for your help.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Macro copy text above
Replies
1
Views
147
Kaper
Kaper
T
  • Solved
VBA Assistance With Copying & Pasting
Replies
6
Views
119
Tommy1115
T
B
  • Question Question
VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area
Replies
0
Views
167
brentcole
B
C
  • Question Question
Find a column header, then copy and paste the column to a different location
Replies
7
Views
207
abdelfattah
A
R
  • Solved
Macro to copy variable length table and paste numerous times in the same sheet
Replies
9
Views
300
rynardc
R

Forum statistics

Threads
1,225,626
Messages
6,186,092
Members
453,337
Latest member
fiaz ahmad

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