Macro for copying cells with specific value in them to another worksheet

jpenndcl

New Member
Joined
Aug 14, 2008
Messages
19
I am trying to copy a row of cells from one worksheet to another worksheet if the value of the first cell in the row is a specific letter/number. Does anyone know the macro code to do this?
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Hi,

May be..

Code:
Sub kTest()
Dim a, v, i As Long, w()

a = Range("A1").CurrentRegion.Resize(, 1)
ReDim w(1 To UBound(a, 1), 1 To 1)
For Each v In a
    If UCase(Left$(v, 1)) = "A" Then 'if the first letter is A
        i = i + 1
        w(i, 1) = v
    End If
Next
With Sheets("Sheet2").Range("a1")
    .Resize(i).Value = w
End With
End Sub
 
Upvote 0
Hi,

May be..

Code:
Sub kTest()
Dim a, v, i As Long, w()

a = Range("A1").CurrentRegion.Resize(, 1)
ReDim w(1 To UBound(a, 1), 1 To 1)
For Each v In a
    If UCase(Left$(v, 1)) = "A" Then 'if the first letter is A
        i = i + 1
        w(i, 1) = v
    End If
Next
With Sheets("Sheet2").Range("a1")
    .Resize(i).Value = w
End With
End Sub


Worked nicely for copying over the individual letter (In your example, "A"), but didn't copy over the entire row of information


I will provide an example (screen shot wasn't working at the moment)...
Worksheet 1

<table x:str="" style="border-collapse: collapse; width: 144pt;" width="192" border="0" cellpadding="0" cellspacing="0"><col style="width: 48pt;" span="3" width="64"> <tbody><tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt; width: 48pt;" width="64" height="17">a</td> <td style="width: 48pt;" width="64">Train</td> <td style="width: 48pt;" width="64">25 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">b</td> <td>car</td> <td>5 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">c</td> <td>boat</td> <td>15 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>28 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>45 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>12 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">c</td> <td>boat</td> <td>2 mph</td> </tr> </tbody></table>

Worksheet 2

<table x:str="" style="border-collapse: collapse; width: 144pt;" width="192" border="0" cellpadding="0" cellspacing="0"><col style="width: 48pt;" span="3" width="64"> <tbody><tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt; width: 48pt;" width="64" height="17">a</td> <td style="width: 48pt;" width="64">Train</td> <td style="width: 48pt;" width="64">25 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>28 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>45 mph</td> </tr> <tr style="height: 12.75pt;" height="17"> <td style="height: 12.75pt;" height="17">a</td> <td>train</td> <td>12 mph</td> </tr> </tbody></table>
 
Upvote 0
Hi,

Code:
Sub kTest()
Dim a, i As Long, w(), n As Long, c As Long

a = Range("A1").CurrentRegion.Resize(, 3) '3 columns
ReDim w(1 To UBound(a, 1), 1 To 3)
For i = 1 To UBound(a, 1)
    If UCase(Left$(a(i, 1), 1)) = "A" Then 'if the first letter is A
        n = n + 1
        For c = 1 To 3: w(n, c) = a(i, c): Next
    End If
Next
With Sheets("Sheet2").Range("a1")
    .Resize(n, 3).Value = w
End With
End Sub

HTH
 
Upvote 0
Hi,

Code:
Sub kTest()
Dim a, i As Long, w(), n As Long, c As Long

a = Range("A1").CurrentRegion.Resize(, 3) '3 columns
ReDim w(1 To UBound(a, 1), 1 To 3)
For i = 1 To UBound(a, 1)
    If UCase(Left$(a(i, 1), 1)) = "A" Then 'if the first letter is A
        n = n + 1
        For c = 1 To 3: w(n, c) = a(i, c): Next
    End If
Next
With Sheets("Sheet2").Range("a1")
    .Resize(n, 3).Value = w
End With
End Sub
HTH


for some reason I get an error message from the following code

.Resize(n, 3).Value = w



Also, if I want to expand the selection that is searched for the corresponding values to 7 columns and 200 rows, how do I do that in your code
 
Upvote 0
Hi,

Try,

Code:
Sub kTest()
Dim a, i As Long, w(), n As Long, c As Long

a = Range("A1").CurrentRegion.Resize(, 7) '7 columns
ReDim w(1 To UBound(a, 1), 1 To 7)
For i = 1 To UBound(a, 1)
    If UCase(Left$(a(i, 1), 1)) = "K" Then 'if the first letter is A
        n = n + 1
        For c = 1 To 7: w(n, c) = a(i, c): Next
    End If
Next
If n > 0 Then
    With Sheets("Sheet2").Range("a1")
        .Resize(n, 7).Value = w
    End With
Else
    MsgBox "No record found", vbInformation
End If
End Sub

HTH
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,700
Members
448,293
Latest member
jin kazuya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top