Копирование и вставка работает только при вставке на лист, а не в ячейки

Question

Доброе утро,

Я пытаюсь скопировать и вставить значения ячеек из основной электронной таблицы на основе ключевого слова, которое я поместил в отдельный лист категории. Затем я вставляю отфильтрованную информацию из основной рабочей таблицы в рабочие таблицы с тем же именем, что и ключевое слово.

Я хочу иметь возможность указать, в какую ячейку я вставляю всю информацию (информация о 10 столбцах), но когда я пытаюсь это сделать, это не работает. Это работает только когда я вставляю в лист без указания начальной ячейки c.

Это код при вставке в лист

Private Sub CommandButton2_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set Source = Category.Range(Category.Range("A1"), Category.Range("A1").End(xlDown))
    Set Rng = dashboard.Range("A8", dashboard.Range("N8").End(xlDown))

    For Each MyCell In Source
        If Not Evaluate("ISREF('" & CStr(MyCell) & "'!A1)") Then
            ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
            ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = MyCell
        End If
    Next MyCell

    For Each MyCell In Source

        dashboard.Range("A8").AutoFilter Field:=13, Criteria1:=MyCell
        On Error Resume Next
        Rng.SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Worksheets(MyCell.Value).Paste
        dashboard.Range("A8").AutoFilter Field:=13

    Next MyCell

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Приведенный выше код работает, но он всегда сбрасывает данные в ячейке A1. Я хочу сделать форматирование вокруг него, поэтому нужно иметь возможность указать ячейку, в которую вставляется информация. Любая помощь будет принята с благодарностью.

Я пробовал приведенный ниже код для вставки в указанную c ячейку, но он не работает.

Private Sub CommandButton2_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set Source = Category.Range(Category.Range("A1"), Category.Range("A1").End(xlDown))
    Set Rng = dashboard.Range("A8", dashboard.Range("N8").End(xlDown))

    For Each MyCell In Source
        If Not Evaluate("ISREF('" & CStr(MyCell) & "'!A1)") Then
            ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
            ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = MyCell
        End If
    Next MyCell

    For Each MyCell In Source

        dashboard.Range("A8").AutoFilter Field:=13, Criteria1:=MyCell
        On Error Resume Next
        Rng.SpecialCells(xlCellTypeVisible).Copy
        ThisWorkbook.Worksheets(MyCell.Value).Range("A1").Paste
        dashboard.Range("A8").AutoFilter Field:=13

    Next MyCell

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Заранее спасибо.