Копировать и вставлять данные между книгами в зависимости от выпадающего списка

Question

Просто быстро, я кодировал фрагмент VBA, который копирует и вставляет данные между двумя рабочими книгами. Однако я хотел бы иметь возможность копировать определенные c данные по всей, а не по всей таблице. Итак, рабочая книга "x" Я бы хотел отфильтровать столбец "L", выбрав раскрывающийся список в рабочей книге "y" - поле "P14".

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

Код ниже для того, что я сделал до сих пор:

Private Sub CommandButton1_Click()

    Dim x As Workbook
    Dim y As Workbook
    Dim p As String

    Set p = y.Worksheets("Title").Cells(14, "P").Value
    Set x = Workbooks.Open("C:\Users\name\Desktop\Project
    Autonetics\CoreData")
    'x.Worksheets("Xero").Range("L1").AutoFilter Field:=1, Criteria:="p"
    With Xero
        .AutoFilterMode = False
        With .Range("L:L")
            .AutoFilter Field:=1, Criteria:="p"
            .SpecialCells (xlCellTypeVisible)
        End With
    End With
    Set y = ThisWorkbook
    x.Worksheets("Xero").Range("A1:L100000").Copy
    Application.DisplayAlerts = False
    y.Worksheets("Costings").Range("A1").PasteSpecial

    x.Close
End Sub

Answer 1

Вот кое-что для вас, чтобы работать с. Лично я не такой On Error фанат, но было бы законно использовать внутри, чтобы проверить возвращаемую ошибку при использовании SpecialCells.

Private Sub CommandButton1_Click()

Dim wb1 As Workbook, wb2 As Workbook
Dim sht1 As Worksheet, sht2 As Worksheet
Dim lc As Long, lr As Long
Dim rng As Range, str As String

'Set your two workbooks
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("C:\Users\name\Desktop\ProjectAutonetics\CoreData")

'Set your two worksheets
Set sht1 = wb1.Worksheets("Title")
Set sht2 = wb2.Worksheets("Xero")

'Get your criteria ready
str = sht1.Range("P14").Value

'Get your range to filter ready
With sht2
    lr = .Cells(.Rows.Count, 12).End(xlUp).Row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set rng = .Range(.Cells(1, 1), .Cells(lr, lc))
End With

'Apply filter and act if any hits
rng.AutoFilter 12, str
If rng.SpecialCells(12).Cells.Count > rng.Rows(1).Cells.Count Then
    rng.SpecialCells(12).Copy sht1.Cells(1, 1)
End If

'Close your second workbook
wb2.Close False

End Sub

Я был довольно обширным в надежде, что вы можете ясно Посмотрите, что происходит в этом коде.

Удачи.