Copying only certain cells within a row of data

[Emily A]

Hi everyone! First of all, I appreciate the help! I amworking on a project for work and have never used VBA before so everything I amlearning is from these forum and YouTube videos. We have a large spreadsheetfor work where anyone can put a PO request in. These requests include theindividuals name, project descriptions, as well as other information relatingto the project. I am trying to send out only 5 of the 25 columns in an emailusing Outlook. To start off with my code, I am just trying to learn how to copythe desired cells. Through this forum, I have learned how to copy and paste the entirerow. Is there a way to copy all of the rows with only the columns I want? I have copied and pastedmy code below! Thanks again for your help.

Sub CopyData()
a = Worksheets("Active").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a 'for each row between 2 and the final row with data
If Worksheets("Active").Cells(i, 3).Value = "Michael" Then

Worksheets("Active").Rows(i).Copy
Worksheets("Sheet3").Activate
b = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet3").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Active").Activate

End If
Next
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
One option is too change your copy line to

   Worksheets("Active").Range("A" & i).Resize(, [COLOR=#ff0000]10[/COLOR]).Copy

Change the value in red to suit. This will currently copy 10 columns, ie cols A:J

 

[Fluff]

Another option, without using loops, would be

Sub CopyData()

   With Worksheets("Active")
      If .AutoFilterMode Then .AutoFilterMode = False
      .Range("A1").AutoFilter 3, "Michael"
      .UsedRange.Offset(1).SpecialCells(xlVisible).Copy _
      Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).ofset(1)
      .AutoFilterMode = False
   End With
End Sub

 

[Joe4]

Welcome to the Board!

If the columns you want to copy are all over the place, you can do it like this. This example copies column A to A, C to B, and E to C.

Sub CopyData()

    Dim a As Long
    Dim i As Long
    Dim b As Long

    Application.ScreenUpdating = False

    a = Worksheets("Active").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To a 'for each row between 2 and the final row with data
        If Worksheets("Active").Cells(i, 3).Value = "Michael" Then
            b = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Sheet3").Cells(b + 1, "A") = Worksheets("Active").Cells(i, "A")
            Worksheets("Sheet3").Cells(b + 1, "B") = Worksheets("Active").Cells(i, "C")
            Worksheets("Sheet3").Cells(b + 1, "C") = Worksheets("Active").Cells(i, "E")
        End If
    Next i
    
    Application.ScreenUpdating = True
    
End Sub

 

[Emily A]

Thank you so much! With that code, is there a way to keep the formatting from the original page?

 

[Joe4]

This modification to my original code should include the formatting from the copied cells:

Sub CopyData()

    Dim a As Long
    Dim i As Long
    Dim b As Long

    Application.ScreenUpdating = False

    a = Worksheets("Active").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To a 'for each row between 2 and the final row with data
        If Worksheets("Active").Cells(i, 3).Value = "Michael" Then
            b = Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Active").Cells(i, "A").Copy Worksheets("Sheet3").Cells(b + 1, "A")
            Worksheets("Active").Cells(i, "C").Copy Worksheets("Sheet3").Cells(b + 1, "B")
            Worksheets("Active").Cells(i, "E").Copy Worksheets("Sheet3").Cells(b + 1, "C")
        End If
    Next i
    
    Application.ScreenUpdating = True
    
End Sub

 

[Emily A]

Thank you! That is keeping the formatting (aka color and font style), but is there a way to keep the same cell height/width?

 

[Joe4]

Thank you! That is keeping the formatting (aka color and font style), but is there a way to keep the same cell height/width?

The issue there is that those are row/column attributes, not cell attributes.
One thing I am not sure I understand, if this is just used to send data to Outlook to send emails, what does it matter what the size of the Excel rows and columns is?

If I were you, and you want to maintain all the "look" of the original data, I might try a different approach, maybe something like this:
- Copy the ENTIRE sheet over to the new sheet
- Delete the columns you don't need
- Use Data filters to hide the rows you don't need
- Delete the filtered rows

You should be able to get the VBA code for the first three by using the Macro Recorder, and record yourself performing those steps manually.
For the last step, see here for VBA code to delete the filtered rows: https://www.mrexcel.com/forum/excel...ofiltered-rows-except-header.html#post2383386