Automate copy and paste data from single row to different rows and columns


Hi there. I am new to Excel macro and this is my time attempt to write a macro for my new job. The objective of writing this macro is to automate the copy of selected data from one worksheet into another worksheet.

The data I need to copy is from a finance master list with hundreds to thousands of rows. After applying filter based on dates, I need to copy selected data from this master list, starting with the first row, and paste them into a table in another worksheet. This process will repeat for the next row in the master list, until the end of the filtered list. Do note that the data required from master list, Sheet1, are from one row but in different column, and need to be pasted into Sheet2 on separate row and column.

I only managed to create the first set of codes, that is to copy from Sheet1 to Sheet2, and then in Sheet2, duplicate the table to the next empty row, with two empty rows in between from the previous table. I am stuck now as I don't know how to loop the steps, in order to repeat the same process from the second row in Sheet1, and paste the new data into a new table in Sheet2. Can someone please help? Many thanks in advance.

Below are my code:

Sub CopyToJournal()
 'Copy selected data from master list in Sheet1 to Journal in Sheet2
Sheets("Sheet1").Range("K4656").Copy Sheets("Sheet2").Range("D2:F2")
Sheets("Sheet1").Range("G4656").Copy Sheets("Sheet2").Range("H2")
Sheets("Sheet1").Range("J4656").Copy Sheets("Sheet2").Range("C6")
Sheets("Sheet2").Range("D6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Sheet1").Range("L4656").Copy Sheets("Sheet2").Range("G6:H6")
Sheets("Sheet1").Range("C4656").Copy Sheets("Journal").Range("C7")
Sheets("Sheet2").Range("D7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Sheet1").Range("P4656").Copy Sheets("Sheet2").Range("E7")
Sheets("Sheet1").Range("L4656").Copy Sheets("Sheet2").Range("G7:H7")
Sheets("Sheet1").Range("S4656").Copy Sheets("Sheet2").Range("D8")

'Create additional table after copy
Sheets("Sheet2").Range("B2:H8").Copy Sheets("Sheet2").Range("B11")
 End Sub



I have re-written your code to make it suitable for looping. In the code below a row number is defined before the procedure starts: R = 4656. The code takes the data from that row, assigns it to an array and then distributes the values to Sheet2. If you change only this number completely different data will be taken from another row and then distributed in the same way.

Note that although the array reads more data from Sheet1 than your code it works many times faster. Accessing a worksheet is slow. This code reads the source sheet only once.

Sub CopyToJournal()
    'Copy selected data from master list in Sheet1 to Journal in Sheet2

    Dim Arr As Variant
    Dim R As Long

    R = 4656
    With Worksheets("Sheet1")
        ' copy the entire row to an array
        Arr = .Range(.Cells(R, "A"), .Cells(R, "S")).Value
        '  an alternative (more flexible) way of addressing this range is
        '     .Range(.Cells(R, 1), .Cells(R, 19))
        '  using column numbers instead of names
    End With

    ' The array has a single row and 19 columns.
    ' Address the cells as Arr([Row], [Column]),
    ' like Arr(1, 11) which holds the value of Cells(R, 11) or Range("K" & R)
    ' Because there is only one row, the first coordinate is always 1
    ' The array holds only values, no cell formats.
    ' Find a column number with code like Debug.Print Columns("AB").Column

    Application.ScreenUpdating = False      ' speed up execution

    ' don't use the "Sheets" collection before you know what it is.
    ' for now, I presume you only know "Worksheets"
    With Worksheets("Sheet2")
        .Range("D2").Value = Arr(1, 11)
        ' .Range("K4656").Copy Sheets("Sheet2").Range("D2:F2")
        ' If you assign several cells the same value, all will have the same value
        ' If these are merged cells, assign the value to the first cell
        .Range("H2").Value = Arr(1, 7)
        .Range("C6").Value = Arr(1, 10)
        .Range("D6").Value = Arr(1, 15)
        .Range("D7").Value = Arr(1, 15)         ' sure you want to write the same value to D6:D7?
        .Range("G6:H6").Value = Arr(1, 12)      ' sure you want to write to 2 cells?
        .Range("G7:H7").Value = Arr(1, 12)      ' sure you want to write to 4 cells?
        .Range("C7").Value = Arr(1, 3)
        .Range("E7").Value = Arr(1, 16)
        .Range("D8").Value = Arr(1, 19)
    End With

'   let's leave this to another time
'    'Create additional table after copy
'    Sheets("Sheet2").Range("B2:H8").Copy Sheets("Sheet2").Range("B11")

    Application.ScreenUpdating = True           ' now the screen updates
End Sub

I have raised some questions about the logic of your code. You should be able to deal with them once you understand how the code works now.

However, even if the code is almost ready for looping it appears that you are not. Data from the next row of Sheet1 would over-write those written to Sheet2 before. And there seems to be no pattern by which the data from another row could be written to the "Journal" besides or below any data placed there by an earlier loop. In fact, Sheet2 doesn't look like a "Journal" at all, perhaps more like a journal voucher.

Anyway, that would be the subject of another question, perhaps. in this thread we should make sure that you can work with the code and syntax I have provided above. t will greatly enhance the scope of your VBA prowess.


Answer the Question

You must create an account to use the forum. Create an Account or Login