VBA code that copies rows of data from 1 workbook to another.

[danbates]

Hi,

I am trying to copy the first 250 rows of data from 1 workbook to another so the daily file I use doesn't get too big.

What I want to happen is the following:

1. Select and copy or cut the first 250 rows. Filename PO Cover
2. Paste onto file name Book1 but looking for the first blank row.
3. Save Book1 and close the file.
4. Delete the selected 250 rows from file name PO Cover.
5. Save PO Cover

This is the code I have so far:

Option Explicit

Sub Macro1()


Dim lrcd As Long
Dim wb As Workbook
Dim ws As Worksheet


 With Application
.ScreenUpdating = False




    Application.Run "'PO COVER 2019.xlsm'!UnlockandDisable"
    Rows("3:253").Select
    Application.CutCopyMode = False
    Selection.Cut
'    Selection.Delete Shift:=xlUp
    ActiveWorkbook.Save


    
Set wb = Workbooks.Open(Filename:="C:\Users\Dell\Desktop\Book1.xlsx")
Set ws = wb.Worksheets("copy")


   lrcd = Sheets("copy").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("copy").Cells(lrcd + 1, "A").Select


[COLOR=#ff0000]Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _[/COLOR]
[COLOR=#ff0000]    :=False, Transpose:=False[/COLOR]
    
Sheets("copy").Cells(lrcd + 1, "A").Select


wb.Worksheets("copy").Save
wb.Worksheets("copy").Close


With Application
.ScreenUpdating = True


End With
End With


End Sub

I know I haven't got all the code there at the moment but that's because I keep getting this error Pastespecial method of range class failed and I can't get past it.

Any help would be appreciated.

Thanks

Dan

 

[mumps]

Place the following macro in a standard module in the PO Cover workbook and run it from there. Change the source sheet name (highlighted in red in the code) to suit your needs.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, desWB As Workbook, srcWs As Worksheet
    Set srcWB = ThisWorkbook
    Set srcWs = srcWB.Sheets("[COLOR="#FF0000"]Sheet1[/COLOR]")
    Set desWB = Workbooks.Open(Filename:="C:\Users\Dell\Desktop\Book1.xlsx")
    srcWs.Rows("3:252").EntireRow.Copy
    Sheets("copy").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    desWB.Close True
    srcWs.Rows("3:252").EntireRow.Delete
    srcWB.Save
    Application.ScreenUpdating = True
End Sub

 

[danbates]

It's absolutely perfect mumps, thank you so much.

 

[mumps]

You are very welcome.