In this article, I’ll show you how to develop and run a **Macro** to copy data from one workbook to another based on criteria. You’ll learn to copy data based on both single criteria and multiple criteria.

**Table of Contents**hide

**Download Practice Workbook**

**Excel Macro to Copy Data from One Workbook to Another Based on Criteria**

Here I’ve got two workbooks called **Workbook1** and **Workbook2**. In Workbook1, we have the **Names, Types,** and **Prices** of some books in a bookshop called Martin Bookstore.

Today we’ll develop a **Macro** to copy data from **Workbook1** to **Workbook2** based on both single and multiple criteria.

**1. Develop Macro to Copy Data from one Workbook to Another Based on a Single Criteria in Excel**

First of all, let’s try to develop the **Macro** to copy data from one workbook to another based on a single criterion.

Let’s copy the **names** and **prices** of the books with prices greater than **$20** from **Workbook1** to **Workbook2**.

You can use the following **VBA** Code:

**⧪**** VBA Code:**

```
Sub Copy_Data_Based_on_Single_Criteria()
Column_Numbers = InputBox("Enter the Column Numbers of Your Selected Range to Copy [Separated by Commas]: ")
Dim Columns() As String
Columns = Split(Column_Numbers, ",")
Workbook = InputBox("Enter the Name of the Destination Workbook: ")
Sheet = InputBox("Enter the Name of the Worksheet: ")
Criteria_Column = Int(InputBox("Enter the Number of the Column with the Criteria: "))
Criteria = Int(InputBox("Enter the Criteria: " + vbNewLine + "Enter 1 for Greater than a Value. " + vbNewLine + "Enter 2 for Greater than or Equal to a Value. " + vbNewLine + "Enter 3 for Less than a Value. " + vbNewLine + "Enter 4 for Less than or Equal to a Value. " + vbNewLine + "Enter 5 for Equal to a Value. " + vbNewLine + "Enter 6 for Not Equal to a Value. " + vbNewLine + "Enter 7 for a Partial Match. "))
Value = InputBox("Enter the Value to Compare: ")
Condition = 0
Row = 1
Column = 1
For i = 1 To Selection.Rows.Count
If Criteria = 1 Then
If Selection.Cells(i, Criteria_Column) > Int(Value) Then
Condition = 1
End If
ElseIf Criteria = 2 Then
If Selection.Cells(i, Criteria_Column) >= Int(Value) Then
Condition = 1
End If
ElseIf Criteria = 3 Then
If Selection.Cells(i, Criteria_Column) < Int(Value) Then
Condition = 1
End If
ElseIf Criteria = 4 Then
If Selection.Cells(i, Criteria_Column) <= Int(Value) Then
Condition = 1
End If
ElseIf Criteria = 5 Then
If Selection.Cells(i, Criteria_Column) = Value Then
Condition = 1
End If
ElseIf Criteria = 6 Then
If Selection.Cells(i, Criteria_Column) <> Value Then
Condition = 1
End If
ElseIf Criteria = 7 Then
If InStr(1, Selection.Cells(i, Criteria_Column), Value) Then
Condition = 1
End If
End If
If Condition = 1 Then
For j = 0 To UBound(Columns)
Workbooks(Workbook).Sheets(Sheet).Range(Selection.Cells(Row, Column).Address).Value = Selection.Cells(i, Int(Columns(j)))
Column = Column + 1
Next j
Row = Row + 1
Column = 1
End If
Condition = 0
Next i
End Sub
```

**⧭**** Note: **This code creates a **Macro** called **Copy_Data_Based_on_Single_Criteria**.

**⧭**** Output: **

Select the data set from the source workbook and** run this Macro**. Here I’ve selected range **B4:D13** from **Workbook1** and run the **Macro**.

You’ll get a few **Input boxes**.

The 1st **Input Box** will ask you to enter the numbers of the columns of the data set that you want to copy (Separated by **Commas**).

Here I want to copy the **Book Names** and **Prices**. So I’ve entered **1,3**.

Click **OK**. The 2nd **Input Box** will ask you the name of the **destination Workbook**.

Here I want to copy data to **Workbook2**. So I’ve entered **Workbook2**.

The 3rd **Input Box** will ask you the **worksheet name** of the destination workbook where you want to copy data.

I want to copy data to **Sheet1** of **Workbook2**.

So I have entered **Sheet1**.

The 4th **Input Box** will ask you to enter the number of the column with the criteria.

Here my criterion is price greater than **$20**, which lies in column **3** of my selected data set.

So I’ve entered **3**.

The 5th **Input Box** will ask you to enter the **criterion**.

Enter **1** if the criterion is greater than a value.

**2** if is greater than or equal to a value.

**3** if it is less than a value.

**4** for less than or equal to a value.

**5** for equal to a value.

**6** for not equal to a value.

And finally, **7** for a partial match.

My criterion is prices greater than **$20**. So I’ve entered **1**.

And finally, the **6th** and final **Input Box** will ask you to enter the value to compare.

Here I want books with prices greater than **$20**. So, I’ve entered **$20**.

Click **OK**. And you’ll find the names and prices of the books with prices greater than **$20** copied from **Workbook1** to **Sheet1** of **Workbook2**.

**Similar Readings**

**How to Copy and Paste in Excel Using VBA (7 Methods)****Update One Excel Worksheet from Another Sheet Automatically****How to Copy a Worksheet in Excel (5 Smart Ways)****Copy and Paste Multiple Cells in Excel (7 Quick Ways)**

**2. Run Macro to Copy Data from one Workbook to Another Based on Multiple Criteria in Excel (Both AND and OR Type)**

This time we’ll develop another **Macro** to copy data from one workbook to another based on multiple criteria.

Let’s try to copy the **names, types**, and** prices** of the books which are either novels or have prices greater than **$20**.

You can use the following **VBA Code **for this purpose.

**⧪**** VBA Code:**

```
Sub Copy_Data_Based_on_Multiple_Criteria()
Column_Numbers = InputBox("Enter the Column Numbers of Your Selected Range to Copy [Separated by Commas]: ")
Dim Columns() As String
Columns = Split(Column_Numbers, ",")
Workbook = InputBox("Enter the Name of the Destination Workbook: ")
Sheet = InputBox("Enter the Name of the Worksheet: ")
Criteria_Column_Numbers = InputBox("Enter the Numbers of the Columns with the Criteria [Separated by Commas]: ")
Dim Criteria_Columns() As String
Criteria_Columns = Split(Criteria_Column_Numbers, ",")
Multiple_Criteria = InputBox("Enter the Criteria: " + vbNewLine + "Enter 1 for Greater than a Value. " + vbNewLine + "Enter 2 for Greater than or Equal to a Value. " + vbNewLine + "Enter 3 for Less than a Value. " + vbNewLine + "Enter 4 for Less than or Equal to a Value. " + vbNewLine + "Enter 5 for Equal to a Value. " + vbNewLine + "Enter 6 for Not Equal to a Value. " + vbNewLine + "Enter 7 for a Partial Match. ")
Dim Criteria() As String
Criteria = Split(Multiple_Criteria, ",")
Criteria_Type = Int(InputBox("Enter 1 for OR Type Criteria: " + vbNewLine + "OR" + vbNewLine + "Enter 2 for AND Type Criteria: "))
Compare_Values = InputBox("Enter the Values to Compare: ")
Dim Values() As String
Values = Split(Compare_Values, ",")
Condition = 0
Conditions = 0
Row = 1
Column = 1
For i = 1 To Selection.Rows.Count
For j = 0 To UBound(Criteria_Columns)
If Int(Criteria(j)) = 1 Then
If Selection.Cells(i, Int(Criteria_Columns(j))) > Int(Values(j)) Then
Condition = Condition + 1
End If
ElseIf Int(Criteria(j)) = 2 Then
If Selection.Cells(i, Int(Criteria_Columns(j))) >= Int(Values(j)) Then
Condition = Condition + 1
End If
ElseIf Int(Criteria(j)) = 3 Then
If Selection.Cells(i, Int(Criteria_Columns(j))) < Int(Values(j)) Then
Condition = Condition + 1
End If
ElseIf Int(Criteria(j)) = 4 Then
If Selection.Cells(i, Int(Criteria_Columns(j))) <= Int(Values(j)) Then
Condition = Condition + 1
End If
ElseIf Int(Criteria(j)) = 5 Then
If Selection.Cells(i, Int(Criteria_Columns(j))) = Values(j) Then
Condition = Condition + 1
End If
ElseIf Int(Criteria(j)) = 6 Then
If Selection.Cells(i, Int(Criteria_Columns(j))) <> Values(j) Then
Condition = Condition + 1
End If
ElseIf Int(Criteria(j)) = 7 Then
If InStr(1, Selection.Cells(i, Criteria_Columns(j)), Values(j)) Then
Condition = Condition + 1
End If
End If
Next j
If Criteria_Type = 1 Then
If Condition >= 1 Then
Conditions = 1
End If
Else
If Condition = UBound(Criteria) + 1 Then
Conditions = 1
End If
End If
Condition = 0
If Conditions = 1 Then
For j = 0 To UBound(Columns)
Workbooks(Workbook).Sheets(Sheet).Range(Selection.Cells(Row, Column).Address).Value = Selection.Cells(i, Int(Columns(j)))
Column = Column + 1
Next j
Row = Row + 1
Column = 1
End If
Conditions = 0
Next i
End Sub
```

**⧭**** Note: **This code creates a **Macro** called **Copy_Data_Based_on_Multiple_Criteria**.

**⧭**** Output: **

Select the data set from the source workbook and** run this Macro**. Here I’ve selected range **B4:D13** from **Workbook1** and run the **Macro**.

You’ll get a few **Input boxes**.

The 1st **Input Box** will ask you to enter the numbers of the columns of the data set that you want to copy (Separated by **Commas**).

Here I want to copy the **Book Names**, **Types**, and **Prices**. So I’ve entered **1,2,3**.

Click **OK**. The 2nd **Input Box** will ask you the name of the **destination Workbook**.

Here I want to copy data to **Workbook2**. So I’ve entered **Workbook2**.

The 3rd **Input Box** will ask you the **worksheet name** of the destination workbook where you want to copy data.

This time I want to copy data to the **Sheet2** of **Workbook2**.

So I have entered **Sheet2**.

The 4th **Input Box** will ask you to enter the numbers of the columns with the criteria.

Here my criteria are book type **novel **and price greater than **$20**, which lies in columns **2 **and **3** of my selected data set.

So I’ve entered **2,3**.

The 5th **Input Box** will ask you to enter the **criteria**.

Enter **1** for greater than a value.

**2** for greater than or equal to a value.

**3** for less than a value.

**4** for less than or equal to a value.

**5** for equal to a value.

**6** for not equal to a value.

And finally, **7** for a partial match.

My criteria are **book type** equal to **Novel** and **price** greater than **$20**. So I’ve entered **5,1** (**Equal to, Greater than**).

The 6th **Input Box** will ask for **AND Type** or **OR Type** criteria.

Enter **1** for an **OR Type** criteria.

**2** for **AND Type** criteria.

I have entered **1.**

And finally, the **7th** and final **Input Box** will ask you to enter the values to compare.

Here I want the books with types of **Novel** or prices greater than **$20**. So, I’ve entered **Novel,20**.

Click **OK**. And you’ll find the **names, types**, and **prices** of the books with book type **Novel** or prices greater than **$20** copied from **Workbook1** to **Sheet1** of **Workbook2**.

**Things to Remember**

- The
**source workbook**and the**destination workbook**must be kept in the same folder on your computer. Otherwise, the code won’t work. - While copying based on multiple criteria, you can have all the criteria from the same column. For example, you can copy the books with prices
**greater than $20**and**less than $30**. In that case, enter**3,3**in the**4th Input Box**. - Here I’ve shown multiple criteria with
**2**criteria. Obviously, you can use it for as many criteria as you like. - The
**equal to, not equal to**, and**partial match**criteria are**case-sensitive**.

**Conclusion**

Using the two methods, you can develop the **Macro** to copy data from one workbook to another based on single and multiple criteria. Do you have any questions? Feel free to ask us.

## Related Readings

**Paste Options in Excel with Shortcuts: A Complete Guide****How to Copy and Paste Thousands of Rows in Excel (3 Ways)****Copy and Paste Exact Formatting in Excel(Quick 6 Methods)****How to Copy the Same Value in Multiple Cells in Excel (4 Methods)**

Nice job,

It works fine until the line below, where it stops and show error 9: subscript out of range.

Workbooks(Workbook).Sheets(Sheet).Range(Selection.Cells(Row, Column).Address).Value = Selection.Cells(i, Int(Columns(j)))

any idea about the error?

Thank you Ana. It’s difficult to give any suggestions without having a glance at the workbook. Would you please kindly share your workbook with me?