Copy File Macro - Prevent from seeing "Chunking Along"

[Logit]

The attached project / copy file macro performs as needed but the user will see as it copies each row. Reminds me of a "chunking along" action.

Is there someway to keep it from doing that ?

Requires an empty workbook named "Backup.xlsx"

Thank you ahead of time !

[Logit]

Never mind. I answered my own questions. Screenupdating = False.

It's been a long day staring at the screen.

Thank you !

[Norie]

Why are you opening/closing the destination workbook every time you want to copy a row to it?

Open it once, then run through the source data copying what's required and then close it.

Try this.

Sub CopyToBackupFile()
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim LastRow As Long, i As Long

    Set wsSrc = ActiveSheet

    LastRow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    Set wbDst = Workbooks.Open(Filename:="C:\Users\My\Desktop\Backup.xlsx")
    Set wsDst = wbDst.Worksheets("Sheet1").Select

    For i = 4 To LastRow

        If wsSrc.Cells(i, 1) <> "" Then
            wsSrc.Cells(i, 1).Resize(, 16).Copy wsDst.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If

    Next i

    wbDst.Close SaveChanges:=True

    Application.ScreenUpdating = True
    
End Sub

[Logit]

Is there a way to copy and paste the formatting of the cells being copied as well ?

I've tried (in my code):

With Sheet1.Cels
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteFormats
        .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
End With

[Logit]

Norie:

The syntax hangs on:

 Set wsDst = wbDst.Worksheets("Sheet1").Select

Error code: Object required.

Looks like the object is there already ?

[Norie]

Oops, that's a typo.

Try this, which should copy everything.

Sub CopyToBackupFile()
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim LastRow As Long, i As Long

    Set wsSrc = ActiveSheet

    LastRow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    Set wbDst = Workbooks.Open(Filename:="C:\Users\My\Desktop\Backup.xlsx")
    Set wsDst = wbDst.Worksheets("Sheet1")

    For i = 4 To LastRow

        If wsSrc.Cells(i, 1) <> "" Then
            wsSrc.Cells(i, 1).Resize(, 16).Copy wsDst.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If

    Next i

    wbDst.Close SaveChanges:=True

    Application.ScreenUpdating = True
    
End Sub

[Logit]

Sorry .. had a typo :

With Sheet1.Cells
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteFormats
        .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
End With

[NoSparks]

Logit,

You realize you are not copying column Q, right ?

If you're going to copy all rows that aren't blank in column A, have you considered using a filter rather than looping ?

[Logit]

NoSparks:

I'm not familiar with "filter", other than the Menu Bar tool selection. Please explain.

Re: Leaving out "Q" ... thanks. Another typo.

[NoSparks]

something along the lines of this will do the copy in one shot

Sub CopyToBackupFile()

    Dim srcSht As Worksheet
    Dim destWB As Workbook
    Dim FiltRng As Range
    Dim lr As Long

Application.ScreenUpdating = False

Set srcSht = ActiveSheet
lr = srcSht.Cells(Rows.Count, "A").End(xlUp).Row
Set FiltRng = srcSht.Range("A3:P" & lr)

Set destWB = Workbooks.Open Filename:="C:\Users\My\Desktop\Backup.xlsx"
'Set destWB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "Backup.xlsx")

With FiltRng
    .AutoFilter
    .AutoFilter Field:=1, Criteria1:="<>"
    .Offset(1).Copy
End With

With destWB.Sheets("Sheet1")
    .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
    .Cells(1, 1).Select
End With

destWB.Close SaveChanges:=True

FiltRng.AutoFilter

Application.ScreenUpdating = True

End Sub

[Logit]

NoSparks

Works great.

Is there a means of maintaining the same format of the cells as they are copied over to the backup workbook ?

See #7 above for my previous feeble attempt.

[NoSparks]

.PasteSpecial xlPasteAll should have looked after that.

For me it copied different fonts and cell colors.

Within the macro, put your cursor somewhere in PasteSpecial and hit F1,
On the help page that comes up click on xlPasteType.

[Logit]

This worked ... do you see anything that should be changed ?

With destWB.Sheets("Sheet1")
    .cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteColumnWidths
    .cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
    .cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats 'PasteSpecial xlPasteAll
    .cells(1, 1).Select
End With

[NoSparks]

That looks OK to me but I think only experimentation will tell you for sure.

After a little further testing I did find that xlPasteAll didn't actually paste all, just most things.
Needed the xlPasteColumnWidths to be implemented first, as you no doubt also discovered.

The cells(1,1).select is just used so as to not leave the sheet with the entire copy area selected (I hate opening up a sheet to find a massive range selected).

[Logit]

Thanks friend. Sent you a private message.