Копирование зацикленных данных из одной книги и вставка в другую

Question

Я написал этот код, и он работает при переходе с одного листа на другой.(Та же рабочая тетрадь).Но когда я перебираю строки из рабочей книги в рабочую книгу, я получаю индекс «Ошибка времени выполнения 9» вне диапазона.

Я несколько раз проверял, соответствуют ли имена файлов в коде, и это не так.Кажется, это проблема.Также, если я в первой части пишу y.sheets («Tavledisplay») вместо листов («Tavledisplay»), отладчик говорит мне, что там есть проблема.Делая это последним способом, он отправляет 1 цикл данных и останавливается на y.sheets("Tavledisplay").Activate.

Мой код:

Dim x As Workbook
Dim y As Workbook

Set x = Workbooks.Open("C:\Users\u054939\Desktop\Diverse filer\Safecard\Safecardmaster.xlsm")
Set y = Workbooks.Open("C:\Users\u054939\Desktop\Diverse filer\Safecard\Tavleark1.xlsm")

    a = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To a

        If Worksheets("Tavledisplay").Cells(i, 14).Value = "Ja" Then
            Worksheets("Tavledisplay").Rows(i).Select
            Selection.Copy
            x.Sheets("Løsninger").Activate
            b = Worksheets("Løsninger").Cells(Rows.Count, 1).End(xlUp).Row
            x.Sheets("Løsninger").Cells(b + 1, 1).Select
            ActiveSheet.Paste
            y.Sheets("Tavledisplay").Activate
            Selection.ClearContents


    End If

Next i

Application.CutCopyMode = False
x.Sheets("Løsninger").Select

Я ожидаю, что код перебирает все заданные строки,где в столбце 14 есть «Ja», вставка их в другой лист моей книги «Løsninger» и удаление их из другой книги.

Answer 1

Вам не нужно проходить через каждый цикл, простой фильтр поможет вам:

Option Explicit
Sub Test()

    Dim x As Workbook
    Dim y As Workbook
    Dim CopyRange As Range
    Dim LastRow As Long

    Set x = Workbooks.Open("C:\Users\u054939\Desktop\Diverse filer\Safecard\Safecardmaster.xlsm")
    Set y = Workbooks.Open("C:\Users\u054939\Desktop\Diverse filer\Safecard\Tavleark1.xlsm")

    'Look for the range to copy and set it
    With y.Worksheets("Tabledisplay")
        .UsedRange.AutoFilter Field:=14, Criteria1:="Ja"
        LastRow = .Cells(.Rows.Count, 14).End(xlUp).Row
        Set CopyRange = .Range("A2", .Cells(LastRow, .UsedRange.Columns.Count)).SpecialCells(xlCellTypeVisible)
        .AutoFilterMode = False
    End With

    'Paste it to the other sheet
    With x.Worksheets("Løsninger")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        CopyRange.Copy .Cells(LastRow, 1)
    End With

    'Delete the range from the original sheet
    CopyRange.Delete

End Sub