Copy rows to another workbook

Question

This code worked once and then stopped. It runs with no action or errors.

I would like if column "a" of the "export" sheet has a yes to copy the cells from B to J to 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

If changed the "Worksheets("11.2022").Select" to sheet1 which I would prefer as I wouldn't have to change it every month.

Answer 1

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!