Копировать значения в рабочую книгу 1 (основная рабочая книга) из рабочей книги 2, когда значение ячейки в рабочей книге 1 соответствует значению столбца в рабочей книге 2

Question

Я работаю над кодом для копирования данных в рабочую книгу 1 (основная рабочая книга) из рабочей книги 2 на основе критериев.

Критерии: - Если значение ячейки C11 в рабочей книге 1 (основная рабочая книга)равно столбцу A Рабочей книги 2, затем скопируйте все данные из столбцов A-F Рабочей книги 2 в Рабочую книгу 1 (Основная рабочая книга).Обратите внимание, что может быть несколько совпадающих значений (в Рабочей книге 2), которые, возможно, потребуется скопировать в Рабочую книгу 1.

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

Private Sub CommandButton1_Click()

' Get Tiger calendar workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook

' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook

' get the Tiger calendar workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select the Tiger Calendar file"
customerFilename = Application.GetOpenFilename(filter, , caption)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)

' assume range is A1 - M10000 in sheet1
' copy data from Tiger calendar to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets("Sheet1")
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)

targetSheet.Range("B14", "G500").Value = sourceSheet.Range("A2", "G500").Value

' Close customer workbook
customerWorkbook.Close

End Sub

Например, если ячейка C11 в книге 1 = 1232223 (идентификатор продукта), то данныеСкопировать должны быть все детали продаж, связанные с идентификатором продукта.Большая часть данных доступна в Рабочей книге 2.

Answer 1

Кто есть кто, что есть

В этой книге проверьте ячейку C11 на значения в столбце A исходной книги.Найдя, скопируйте диапазон строки и 6 смежных столбцов (AF) в эту книгу, начиная с B14 (BG).Делайте все это, пока не будет достигнут последний ряд данных в исходной рабочей книге.

Private Sub CommandButton1_Click()

  Const filter As String = "Text files (*.xls*),*.xls*"
  Const caption As String = "Please Select the Tiger Calendar file"

  Const wsTarget As Variant = "Sheet1"  ' Target Worksheet Name/Index
  Const cTgtFirst As String = "B14"     ' Target First Cell Range
  Const cTgtSearch As String = "C11"    ' Target Search Value Cell Range
  Const wsSource As Variant = 1         ' Source Worksheet Name/Index
  Const cSrcFirst As Long = 2           ' Source First Row
  Const cSrcFirstCol As Variant = "A"   ' Source First Column Letter/Number
  Const cColumns As Integer = 6         ' Number of Columns

  Dim customerFilename As String
  Dim sourceSheet As Worksheet
  Dim i As Long
  Dim rngTarget As Range

  customerFilename = Application.GetOpenFilename(filter, , caption)

  Set sourceSheet = Workbooks.Open(customerFilename).Worksheets(wsSource)

  With sourceSheet
    Set rngTarget = ThisWorkbook.Worksheets(wsTarget).Range(cTgtFirst)
    For i = cSrcFirst To .Cells(.Rows.Count, cSrcFirstCol).End(xlUp).Row
      If .Cells(i, cSrcFirstCol) = rngTarget.Parent.Range(cTgtSearch) Then
        .Cells(i, cSrcFirstCol).Resize(, cColumns).Copy _
            rngTarget.Resize(, cColumns)
        Set rngTarget = rngTarget.Offset(1, 0)
      End If
    Next
  End With

  sourceSheet.Parent.Close False

End Sub

Answer 2

Вы хотите добавить оператор If в конце.Я не проверял это, но это должно дать вам представление о том, как заставить это работать.

'Your need to change this to what you need
Dim CustomerSheet = Customerworkbook.Worksheets("Sheet1")

If Customersheet.range("C11").value = targetSheet.range("A1").value then
    targetSheet.Range("B14", "G500").Value = sourceSheet.Range("A2", "G500").Value
Else
    Exit Sub
End If