Copy and Paste rows to another workbook, worked once and stopped working-CodePudding

with lots of help from posts on here i have complied this code. it worked once and then stopped. Nothing charged, it just runs with no action or errors. I would like it to look at the "export" sheet and if column "a" has a yes then copy the cells from B to J and paste them on the next clear line in workbook MOSTEST sheet1 (named 11.2022).

Sub DateSave()

Dim LastRow As Integer, i As Integer, erow As Integer
LastRow = Worksheets("EXPORT").Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To LastRow

If Cells(i, 1).Value = "YES" Then
Range(Cells(i, 2), Cells(i, 10)).Select
Selection.Copy

Workbooks.Open Filename:="F:\Orders\MOSTEST.xlsx"
Worksheets("11.2022").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If

Next i

End Sub

It took a lot of messing around to get it here, as i am new to this really. If changed the "Worksheets("11.2022").Select" to sheet1 which i would prefere as i wouldnt have to change it every month.

CodePudding user response：

You should try to avoid using select, see other post

I adjusted your code where needed, I'm still trying to figure out best practice (i.e. it would be better adding the cell ranges to a range variable and then pasting them in one go but I'm not quite there yet) when it comes to minimizing code so if others can do better, feel free :)

Sub DateSave()

    Dim LastRow As Long, i As Long, erow As Long
    Dim wsStr As String
    Dim ws As Worksheet, wsC As Worksheet
    Dim wb As Workbook, wbM As Workbook
    LastRow = Worksheets("EXPORT").Range("A" & Rows.Count).End(xlUp).Row
    
    Set wb = ActiveWorkbook
    Set wsC = wb.Sheets("EXPORT")
    Workbooks.Open Filename:="F:\Orders\MOSTEST.xlsx" 'Don't keep opening and saving/closing your workbook per copy, that would heavily increase runtime
    Set wbM = Workbooks("MOSTEST.xlsx")
    wsStr = Month(Date) & "." & Year(Date)
    Set ws = wbM.Worksheets(wsStr) 'If your currentmonth will always be the first sheet then you can use wbM.Sheets(1)
    erow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    wb.Activate

    For i = 1 To LastRow
        If wsC.Cells(i, 1).Value = "YES" Then
            erow = erow   1
            wsC.Range(wsC.Cells(i, 2), wsC.Cells(i, 10)).Copy 'avoid select
            ws.Range("A" & erow).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
        End If
    Next i
    
    wbM.Save
    wbM.Close
    Application.CutCopyMode = False
End Sub

If you have questions, feel free to ask!