VBA Copy From One Sheet to Another

[speth]

Hello,

I've got a working sheet, and attempting to run a script that checks for items that are old and can be sent to an archive sheet.

"ArchiveCopy" is the working sheet, and "ArchivePaste" is where I want the information copied to. I want the script to look down G:G and check if it says "Wait" or "OK" - OK is good to copy over information in the row.

Part of the problem I'm running into is that I want it to copy a range if it finds an entry, from A:G, but not an entire row because there is information to the right of G that needs to stay.

This is what I have so far, but it also copied the header over to the new sheet. Can anyone help steer me on this one?

Sub CopyPasteArchive()

    Application.ScreenUpdating = False
    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet


    Set copySheet = Worksheets("ArchiveCopy")
    Set pasteSheet = Worksheets("ArchivePaste")
     
    Set rngCriteria_v = pasteSheet.Range("O4:O5")
    Set rngData_v = copySheet.Range("A1:G50")


    Application.CutCopyMode = False
    Application.ScreenUpdating = True


    rngData_v.AdvancedFilter xlFilterCopy, rngCriteria_v, pasteSheet.Cells(pasteSheet.Rows.Count, "A").End(xlUp)(2)


End Sub

In the end, I want the script to also delete the information from ArchiveCopy, but I thought I would tackle one problem at a time.

 

[dmt32]

Hi,
providing that the required headers (fields) in your Archive sheet are identical to those in you Archive Copy Sheet then try change to your code shown in RED

rngData_v.AdvancedFilter xlFilterCopy, rngCriteria_v, pasteSheet.Range("A1:G1")

Dave

 

[speth]

Hi,
providing that the required headers (fields) in your Archive sheet are identical to those in you Archive Copy Sheet then try change to your code shown in RED

rngData_v.AdvancedFilter xlFilterCopy, rngCriteria_v, pasteSheet.Range("A1:G1")

Dave

This is the right idea, but I'm going to run this function every few days to clear out the working sheet - is there a way to dump the entries at the last used row so it can keep adding more each time?

 

[speth]

OK, I ended up getting this to work through another direction.

This scans down for a cell marked "OK", sizes the range to copy and paste from "Change List" to "Archive", and then goes back through and deletes the entries so they only exist at "Archive" - I did that method because I wanted it to preserve some formatting.

Sub CopyPaste()


Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim c As Range '-- this is used to store the single cell in the For Each loop


Set shtSrc = Sheets("Change List") ' Sets sheet as source sheet for searching
Set shtDest = Sheets("Archive") 'Sets sheet as destination sheet for pasting
destRow = Sheets("Archive").UsedRange.Rows.Count + 1 'Start copying to this row on destination sheet


' >> Set range to search through <<
Set rng = Application.Intersect(shtSrc.Range("G:G"), shtSrc.UsedRange)


For Each c In rng.Cells
    If (c.Value = "OK") Then '>> Looking for "OK" in cell <<


        '>> Copy and Paste a range (row, but not whole row) to a the new sheet <<
        shtSrc.Range("A" & c.Row).Resize(, 7).Copy shtDest.Range("A" & destRow).Resize(, 7)
                
        '>> Clear Contents from the source sheet <<
        shtSrc.Range("A" & c.Row).Resize(, 7).ClearContents
                        
        '>> Continue searching <<
        destRow = destRow + 1
        
' >> Ends search for "OK" <<


    End If
Next


End Sub