使用宏在Excel中将行从一个工作表复制到另一个工作表

Question

I have an excel worksheet with whole bunch of rows and several columns in it. The 1st column contains the manufacturer's name, the 2nd column contains the product codes for all the products, the 3rd column contains the description and etc. What I want to do is to copy the rows that corresponds to certain product codes. For example:

**Manufacturer       Product code       Description**
abc                 B010                blah blah
dgh                 A012                
hgy                 X010                
eut                 B013                 
uru                 B014                 
eut                 B015              
asd                 G012            
sof                 B016
uet                 B016 
etc

Is there a way to copy the rows that has the product codes in between B010 - B016? There might be double/matching product codes too, and it is totally fine to copy them too.

Makes sense?

Sorry, i have no vba code to put in here yet.

Thanks in advance.

Answer 1

This should do the trick; it copies the A:C range cells for any B cell values that are between B010 and B016 to the next available row in Sheet2.

Private Sub CopyRows()
    Dim lastrow As Long
    Dim r1 As Long, r2 As Long

    ' Get the last row in the worksheet
    lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

    r2 = 1

    For r1 = 1 To lastrow
        ' If the last three characters of the B cell are numeric...
        If IsNumeric(Right(Sheet1.Range("$B$" & r1).Value, 3)) Then
            ' If the first character of the B cell is "B", and the last three 
            ' characters are between 10 and 16 ...
            If Left(Sheet1.Range("$B$" & r1).Value, 1) = "B" And _
                CLng(Right(Sheet1.Range("$B$" & r1).Value, 3)) >= 10 And _
                CLng(Right(Sheet1.Range("$B$" & r1).Value, 3)) <= 16 Then

                ' ... copy the A-C range for the row to the next available row 
                ' in Sheet2
                Sheet2.Range("$A$" & r2, "$C$" & r2).Value = _
                    Sheet1.Range("$A$" & r1, "$C$" & r1).Value

                r2 = r2 + 1

            End If
        End If
    Next
End Sub