Copy and paste from one sheet to another based on criteria

KayJay0618

New Member
Joined
Jul 20, 2016
Messages
40
I need help with some vba for Excel 2010. I have a workbook with two sheets: Detail and Tally. I've attached images of each sheet. Data is entered every day on the Details sheet. Column J is auto populated with the current date when a prodno is entered in column D and the week to which the date corresponds in our Fiscal year is auto populated in column K. Each week I want to copy the data from the Details sheet columns A, D, J and K to the first blank row on the Tally sheet where the week in column K on the Details sheet is greater than the max week in column D on the Tally sheet. I have a formula in cell $G$1 of the Tally sheet to give me the max week number on the Tally sheet. So essentially I need to

1. activate the Detail sheet,
2. autofilter on column K for week values greater than the value in cell G1 of the Tally sheet
3. copy and paste values from the filtered data from column A, D, J and K only from Detail sheet to Tally sheet's first blank row in cells A, B, C and D.

Hope this makes sense. Below are samples of the two sheets and the code I've written thus far, which gets hung up on the AutoFilter row with run-time error '448' (Named argument not found). I need VBA code to filter on column K on the Detail sheet for a number greater than Tally!$G$1, then copy cells A, D, J and K of the resulting filter (rows 3 and 4) of the Detail sheet to rows 2 and 3 of the Tally sheet.

Code I have so far:

Code:
[Sub CopyWeek()
Worksheets("Details").Activate
Dim lr As Long
Dim newlr As Long
lr = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
   
With ActiveSheet
    .AutoFilter field:=11, Criteria1:=">" & Worksheets("Tally").Range("$G$1")
    Data.Range("A2:A" & lr).Copy
    tly.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
End Sub
/CODE]


Detail Sheet

[TABLE="class: grid, width: 500, align: left"]
<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]
[TD]K
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Salesperson
[/TD]
[TD]Region
[/TD]
[TD]Product
[/TD]
[TD]ProdNo
[/TD]
[TD]SaleDate
[/TD]
[TD]Month
[/TD]
[TD]EAS
[/TD]
[TD]Comments
[/TD]
[TD]ReferralPerson
[/TD]
[TD]Entered
[/TD]
[TD]Week
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Candy Apple
[/TD]
[TD]Central
[/TD]
[TD]Stick
[/TD]
[TD]100480387
[/TD]
[TD]09/25/17
[/TD]
[TD]September
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]09/29/17
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]Sherry Dawn
[/TD]
[TD]Northeast
[/TD]
[TD]Casing
[/TD]
[TD]12633499
[/TD]
[TD]09/19/17
[/TD]
[TD]September
[/TD]
[TD][/TD]
[TD]MC
[/TD]
[TD][/TD]
[TD]10/6/17
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]Andy Wilson
[/TD]
[TD]Northeast
[/TD]
[TD]Fabric
[/TD]
[TD]27690112
[/TD]
[TD]9/28/17
[/TD]
[TD]September
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]10/6/17
[/TD]
[TD]2
[/TD]
[/TR]
</tbody>[/TABLE]













Tally Sheet
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[TD="align: center"]C
[/TD]
[TD="align: center"]D
[/TD]
[TD="align: center"]E
[/TD]
[TD="align: center"]F
[/TD]
[TD="align: center"]G
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Salesperson
[/TD]
[TD]ProdNo
[/TD]
[TD]Entered
[/TD]
[TD]Week
[/TD]
[TD][/TD]
[TD]MaxWeekCopied
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Hi, try this
Code:
Sub CopyWeek()
    
    Dim UsdRws As Long
    Dim TallySht As Worksheet

Application.ScreenUpdating = False
    Set TallySht = Worksheets("Tally")
    
    With Worksheets("Details")
        If .AutoFilterMode Then .AutoFilterMode = False
        UsdRws = .Cells(Rows.Count, 4).End(xlUp).Row
        .Range("A1").AutoFilter field:=11, Criteria1:=">" & TallySht.Range("G1").Value
        Union(.Range("A2:A" & UsdRws).SpecialCells(xlVisible), _
            .Range("D2:D" & UsdRws).SpecialCells(xlVisible), _
            .Range("J2:K" & UsdRws).SpecialCells(xlVisible)).Copy
        TallySht.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        .Range("A1").AutoFilter
    End With
Application.CutCopyMode = False

End Sub
 
Upvote 0
I actually figured out the code - I sent the wrong code in my original thread. If someone has any suggestions to tighten it up, that would be great. I'm learning. Here is the code I now have, which does appear to work.

Code:
Sub CopyWeek()
Worksheets("Details").Activate
Dim lr As Long
Dim newlr As Long
lr = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
   
With ActiveSheet
    .Range("A1:K1").AutoFilter field:=11, Criteria1:=">" & Worksheets("Tally").Range("G1")
    .Range("A2:A" & lr).Copy
    Worksheets("Tally").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    .Range("D2:D" & lr).Copy
    Worksheets("Tally").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    .Range("J2:J" & lr).Copy
    Worksheets("Tally").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    .Range("K2:K" & lr).Copy
    Worksheets("Tally").Range("D" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    AutoFilterMode = False
    Range("A1:K1").AutoFilter
    AutoFilterMode = True
    Range("A1:K1").AutoFilter
End With
End Sub
 
Upvote 0
As we both posted at the same time, did you notice the code I supplied in post#2?
It should do the same thing & saves multiple copy/paste
 
Upvote 0

Forum statistics

Threads
1,214,651
Messages
6,120,742
Members
448,989
Latest member
mariah3

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