当工作簿 1 中的单元格值与工作簿 2 中的列值匹配时，将值从工作簿 2 复制到工作簿 1（主工作簿）

Question

I am working on a code to copy data to Workbook 1 (Main Workbook) from Workbook 2 based on a criteria.

The criteria is - If the value of cell C11 in Workbook 1 (Main Workbook) is equal to column A of Workbook 2, then copy all the data from Workbook 2 columns A to F to Workbook 1 (Main Workbook). Please note that there could be multiple matching values (in Workbook 2) that may need to be copied to Workbook 1.

I have tried the below code that pull all the data perfectly. Now I am trying to see if there is a code which can be applied to copy data based on criteria.

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

For example, if Cell C11 in Workbook 1 = 1232223 (Product ID), then the data copied should be all the sales details related to the product ID. The bulk data is available in Workbook 2.

Answer 1

Who Is Who, What Is What

In this workbook check cell C11 against the values in source workbook's A column. When found, copy the range of the row and 6 contiguous columns (AF) to this workbook starting from B14 (BG). Do all of this until the last row of data in source workbook is reached.

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

You're going to want to add an If statement at the end. I havent tested this, but it should give you an idea of how to get this working.

'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