Copy active cells to new sheet

[OnecallNoel]

Hi,

I am trying to copy active cells in column A, B, C, and D. They need to be pasted into a new sheet in the same workbook. Column A and B need to be copied and pasted into A and B on the new sheet. Then A and C needs to be copy and pasted right underneath the previous data that was pasted (A & B). Then A and D needs to placed right underneath that data. In my head this is fairly simple, but I am not great with VBA and wouldn't mind some help.

Column A data is always repeating the same active cells.

Thanks!

 

[smozgur]

Welcome to the MrExcel Message Board!

Need clarification about "Active cells". Do you mean that you will select cells in A column, and it will copy the corresponding cells? Is multi-range selection possible? Like A2:A5 and A9:A15?

 

[smozgur]

Actually, the following code will work even you select multi areas.

Copy and paste the following code into a standard module, select the cells in column A in the source worksheet that contains data in A, B, C, D columns, and run the macro.

Sub transferData()
Dim rng As Range
Dim cll As Range
Dim sht As Worksheet
Dim trg As Range
Dim j As Integer
Dim i As Integer

    ' Source range
    Set rng = Selection
    ' Target sheet
    Set sht = ThisWorkbook.Worksheets.Add(after:=ActiveSheet)
    ' Starting target range
    ' the following set it as cell A1
    Set trg = sht.Cells(1, 1)
  
    ' Looping for three columns
    For i = 2 To 4 ' B, C, D columns
        ' Assuming multi-area selection is possible
        For j = 1 To rng.Areas.Count
            ' Transferring data from column (i) - B, C, or D according to i value
            For Each cll In rng.Areas(j).Columns(1).Cells
                ' First array item is column A, the other one is B, C, or D
                trg.Resize(, 2) = Array(cll.Cells(1, 1), cll.Cells(1, i))
                ' Set the next target range
                Set trg = trg.Offset(1)
            Next cll
        Next j
    Next i
End Sub

Note: If multi-area selection is not necessary, then it could be handled by using a shorter code.

Edit: I just noticed that you said "new sheet in the same workbook", so I edited the code accordingly.

 

[OnecallNoel]

Welcome to the MrExcel Message Board!

Need clarification about "Active cells". Do you mean that you will select cells in A column, and it will copy the corresponding cells? Is multi-range selection possible? Like A2:A5 and A9:A15?

By active cells I mean the cells that have data in it. So if the data ends at A345 it won't copy below that.

 

[OnecallNoel]

Actually, the following code will work even you select multi areas.

Copy and paste the following code into a standard module, select the cells in column A in the source worksheet that contains data in A, B, C, D columns, and run the macro.

Sub transferData()
Dim rng As Range
Dim cll As Range
Dim sht As Worksheet
Dim trg As Range
Dim j As Integer
Dim i As Integer

    ' Source range
    Set rng = Selection
    ' Target sheet
    Set sht = ThisWorkbook.Worksheets.Add(after:=ActiveSheet)
    ' Starting target range
    ' the following set it as cell A1
    Set trg = sht.Cells(1, 1)
 
    ' Looping for three columns
    For i = 2 To 4 ' B, C, D columns
        ' Assuming multi-area selection is possible
        For j = 1 To rng.Areas.Count
            ' Transferring data from column (i) - B, C, or D according to i value
            For Each cll In rng.Areas(j).Columns(1).Cells
                ' First array item is column A, the other one is B, C, or D
                trg.Resize(, 2) = Array(cll.Cells(1, 1), cll.Cells(1, i))
                ' Set the next target range
                Set trg = trg.Offset(1)
            Next cll
        Next j
    Next i
End Sub

Note: If multi-area selection is not necessary, then it could be handled by using a shorter code.

Edit: I just noticed that you said "new sheet in the same workbook", so I edited the code accordingly.

Thank you! I got this to work. If I wanted to do this for Column A, being column F it would be,

Set trg = sht.Cells(1, 6)

Correct? But then For B, C, or D It would be B = both column M and column O, C = Column P and R, and D = S and U if that makes sense.

So copying the same data for Column F every time while copying M & O, then F, P &R, and then F, S & U.

I thought I would be able to edit this myself for the more complicated version, but for the looping the three columns it isn't clear how to edit it to me.

 

[smozgur]

trg is the target cell, so it is not what you need to change unless you want the copied data to start in a cell other than A1 in the target worksheet.

Following will do what you need:

Sub transferData()
Dim rng As Range
Dim cll As Range
Dim sht As Worksheet
Dim trg As Range
Dim j As Integer
Dim i As Integer

    ' Source range
    Set rng = Selection
    ' Target sheet
    Set sht = ThisWorkbook.Worksheets.Add(after:=ActiveSheet)
    ' Starting target range
    ' the following set it as column A
    Set trg = sht.Cells(1, 1)
   
    ' Looping for three columns relative the column F
    ' 8-10, 11-13, 14-16
    For i = 8 To 14 Step 3
        ' Assuming multi-area selection is possible
        For j = 1 To rng.Areas.Count
            ' Transferring data from M-O, P-R, S-U columns - i is used as the column number relative to F column
            For Each cll In rng.Areas(j).Columns(1).Cells
                ' First array item is column F, the other ones are from the other columns
                trg.Resize(, 3) = Array(cll.Cells(1, 1), cll.Cells(1, i), cll.Cells(1, i + 2))
                ' Set the next target range
                Set trg = trg.Offset(1)
            Next cll
        Next j
    Next i
End Sub

8-10, 11-13, 14-16 are the column numbers starting from the cell F. If you take the cell F as the reference, so F=1, then M=8, O=10 ...
It could be written in many different ways, but your column sequence made it possible to adapt the existing code.

One important point: it is important to notice how we use trg.Resize(,3), and setting the array by using 3 cells this time.

Please let me know if there is something that doesn't make sense.

Edit: First array item is column F in the loop since data starts from there. And another noticeable point is using the loop with Step to match with the 8th, 11st, and 14th columns.

 

[smozgur]

I just noticed that I missed your first reply to my initial question. The Activecell is a special term in VBA, so I wanted to make sure what you meant but assumed you used it as the selection.

By active cells I mean the cells that have data in it. So if the data ends at A345 it won't copy below that.

The following updated code doesn't require selecting the cells and copies all data instead of only selected rows. A bit different methods to use, and it doesn't loop between rows since you need all data in the row. So, in theory, it also works a bit faster.

Sub transferDataV2()
Dim rng As Range
Dim cll As Range
Dim src As Worksheet
Dim sht As Worksheet
Dim trg As Range
Dim i As Integer

    ' Source worksheet
    Set src = ActiveSheet
    
    ' Source range - F=6th column
    Set rng = src.Range(src.Cells(1, 6), src.Cells(1, 6).End(xlDown))
    
    ' Target sheet
    Set sht = ThisWorkbook.Worksheets.Add(after:=src)
    ' Starting target range
    ' the following set it as column A
    Set trg = sht.Cells(1, 1)
    
    For i = 8 To 14 Step 3
        ' Union creates a new range from the selected columns in the source range
        ' and Copy method can be used to transfer data to the target
        Union(rng.Columns(1), rng.Columns(i), rng.Columns(i + 2)).Copy trg
        ' Next target cell
        Set trg = trg.Cells.End(xlDown).Offset(1)
    Next i
End Sub