Limit columns copied to another sheet and combine modules

[smr108]

I have looked on the internet to learn how to write something to copy data from one sheet to another based on values in a column. I have created 3 modules to do that. One of them is below. Each time it overwrites everything in the destination sheet. Is there a way to limit the columns that get copied into the destination sheet? I also run each module as a macro but would like to combine all of them and run them at the same time. Is that possible?

Sub CopyEarn()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet

    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Transactions")
    Set Target = ActiveWorkbook.Worksheets("Earn")

    j = 1     ' Start copying to row 1 in target sheet
    For Each c In Source.Range("B2:B1000")   ' Do 1000 rows
        If c = "Coinbase Earn" Then
           Source.Rows(c.Row).copy Target.Rows(j)
           j = j + 1
        End If
    Next c
End Sub

 

[rollis13]

Try changing this line of code from:
Source.Rows(c.Row).copy Target.Rows(j)
to:
Source.Range("A" & c.Row).Resize(, 6).Copy Target.Range("A" & j)
and update this part of it:
.Resize(, 6)
to suit num. of columns to copy.

What are the other modules supposed to do ? in what do they differ, this line maybe ? (If c = "Coinbase Earn" Then)

 

[smr108]

Thank you for the response! This worked perfectly! All the modules do the same thing based on the line you identified. The others are look for Rewards, Convert, Buy , Send. It would be nice to have them run together. I'm new at this but I think they could be combined.

 

[rollis13]

See if I didn't mess up everything. I added and changed some lines of code.

Option Explicit
Sub CopyEarn()
    Dim c      As Range
    Dim j      As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim srch   As Variant                         '<= added
    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Transactions")
    Set Target = ActiveWorkbook.Worksheets("Earn")
    j = 1                                         ' Start copying to row 1 in target sheet
    For Each c In Source.Range("B2:B1000")        ' Do 1000 rows
        For Each srch In Array("Coinbase Earn", "Rewards", "Convert", "Buy") '<= added
            If c.Value Like srch Then             '<= changed
                'Source.Rows(c.Row).copy Target.Rows(j)
                Source.Range("A" & c.Row).Resize(, 12).Copy Target.Range("A" & j) '<= change .Risize(, 6) to suit num. of columns to copy
                j = j + 1
            End If
        Next srch                                 '<= added
    Next c
End Sub

 

[smr108]

The code runs very well. However, it copies everything into the Earn sheet vs copying the Buy transactions into the Buy Sheet and Send transactions to the Send sheet for example.

 

[rollis13]

Now the macro works with separate Target sheets.
I also have chosen to process only the used rows in Source sheet. Since I have no idea how your data is organized, it's up to you decide which is the best choice.

Option Explicit
Sub CopyEarn()
    Dim c      As Range
    Dim j      As Long
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim srch   As Variant
    Set Source = ActiveWorkbook.Worksheets("Transactions")
    'For Each c In Source.Range("B2:B1000")        'Do 1000 rows
    For Each c In Source.Range("B2:B" & Source.Range("B2").End(xlDown).Row) '<= Does only used rows
        For Each srch In Array("Coinbase Earn", "Rewards", "Convert", "Buy")
            If c Like srch Then
                With ActiveWorkbook.Worksheets(srch)
                    j = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                    Source.Range("A" & c.Row).Resize(, 12).Copy .Range("A" & j)
                End With
            End If
        Next srch
    Next c
End Sub

 

[smr108]

Thank you!!!

 

[rollis13]

Glad having been of some help.
Maybe adding this line would be even better:

[...]
j = .Range("A" & .Rows.Count).End(xlUp).Row
If .Range("A1") <> "" Then j = j + 1  '= added
Source.Range("A" & c.Row).Resize(, 12).Copy .Range("A" & j)
[...]

 

[rollis13]

There is a typo in post #6. Didn't wake up well this morning but now I made up my mind:
To begin pasting from row 2 in target sheets use:

[...]
j = .Range("A" & .Rows.Count).End(xlUp).Row
Source.Range("A" & c.Row).Resize(, 12).Copy .Range("A" & j + 1)   '<= fixed
[...]

instead to start from row 1 use:

[...]
j = .Range("A" & .Rows.Count).End(xlUp).Row
If .Range("A1") <> "" Then j = j + 1    '<= added
Source.Range("A" & c.Row).Resize(, 12).Copy .Range("A" & j)
[...]

 

[smr108]

This revision loads all the sheets except the Buy sheet. In that sheet it only loads column 1.