Copy range to particular cell repetitively

D4n13l · Jul 13th 2015

Hello! I have this boring task to do.

I have 3 columns with data (the rows in this columns are variable). I want to copy every row to another sheet in particular cells.

First row in sheet 1 to sheet 3 in A11, B11, G11, then second row in sheet 1 to sheet 3 in I11, J11, O11, then third row in sheet 1 to sheet 3 in A24, B24, G24, fourth row in sheet 1 to sheet 3 in I24, J24, O24, and so on.

So the used columns are always A, B, G, and I, J, O, and the rows increase of 13.

**Trebor76** · Jul 14th 2015

Re: Copy range to particular cell repetitively

Hi D4n13l,

Welcome to Ozgrid!!

See how this macro goes:

Code

Option Explicit


Sub Macro2()
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    Dim lngLastRow As Long
    Dim lngMyRow As Long
    Dim varMyColumn As Variant
    
    Application.ScreenUpdating = False
    
    Set wsSourceTab = Sheets("Sheet1") 'Sheet name for your raw data. Change to suit.
    Set wsOutputTab = Sheets("Sheet3") 'Sheet name for your raw data to be copied to. Change to suit.
    
    lngLastRow = wsSourceTab.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For lngMyRow = 11 To lngLastRow Step 13
        For Each varMyColumn In Array("A", "B", "G", "I", "J", "O")
            wsSourceTab.Range(varMyColumn & lngMyRow).Copy Destination:=wsOutputTab.Range(varMyColumn & lngMyRow)
        Next varMyColumn
    Next lngMyRow
    
    Set wsSourceTab = Nothing
    Set wsOutputTab = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Done"


End Sub

Display More

Regards,

Robert

D4n13l · Jul 14th 2015

Re: Copy range to particular cell repetitively

I change the sheets as you told me, it works, but I forgot to tell you that the columns in sheet 1 are the F, G and H, from row 3...

Thanks for your help

**Trebor76** · Jul 15th 2015

Re: Copy range to particular cell repetitively

Quote

I change the sheets as you told me, it works, but I forgot to tell you that the columns in sheet 1 are the F, G and H, from row 3...

I'm not sure what you mean as you originally said So the used columns are always A, B, G, and I, J, O?

I think this is maybe what you're after:

Code

Option Explicit


Sub Macro3()
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    Dim lngLastRow As Long
    Dim lngMyRow As Long
    Dim lngPasteRow As Long
     
    Application.ScreenUpdating = False
     
    Set wsSourceTab = Sheets("Sheet1") 'Sheet name for your raw data. Change to suit.
    Set wsOutputTab = Sheets("Sheet3") 'Sheet name for your raw data to be copied to. Change to suit.
     
    lngLastRow = wsSourceTab.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
    For lngMyRow = 3 To lngLastRow
        If lngPasteRow = 0 Then
            lngPasteRow = 11
        Else
            lngPasteRow = lngPasteRow + 13
        End If
        With wsSourceTab
            .Range("F" & lngMyRow & ":G" & lngMyRow).Copy Destination:=wsOutputTab.Range("I" & lngPasteRow)
            .Range("H" & lngMyRow).Copy Destination:=wsOutputTab.Range("O" & lngPasteRow)
        End With
    Next lngMyRow
     
    Set wsSourceTab = Nothing
    Set wsOutputTab = Nothing
     
    Application.ScreenUpdating = True
     
    MsgBox "Done"
     
End Sub

Display More

If not you'll have to attached a workbook with a before and after scenario so I can try and code a solution from that.

Regards,

Robert

ginobuonpanino · Jul 15th 2015

Re: Copy range to particular cell repetitively

It works but not as I hope. I attach a workbook as example... (I simplified the layout in sheet 3 I hope that help you)

forum.ozgrid.com/index.php?attachment/66148/

ginobuonpanino · Jul 15th 2015

Re: Copy range to particular cell repetitively

It works but not as I hope. I attach a workbook as example... (I simplified the layout in sheet 3 I hope that help you)

forum.ozgrid.com/index.php?attachment/66148/

Thanks for your precius help

**Trebor76** · Jul 16th 2015

Re: Copy range to particular cell repetitively

Hi ginobuonpanino,

You must of missed posted in the wrong thread as I have never seen your workbook nor written any of the code in it :confused:

Robert

ginobuonpanino · Jul 16th 2015

Re: Copy range to particular cell repetitively

I'm sorry, I'm working with D4n13l, but now he is on holiday, thats why I'm posting. The workbook I attached is right. I don't put the code, because, I made some changes, because D4n13l used merged cell that caused some error so I simplified the layout to avoid those merged cells.

**Trebor76** · Jul 17th 2015

Re: Copy range to particular cell repetitively

Hi ginobuonpanino,

OK that makes sense (probably would have helped to say that upfront).

Try this:

Code

Option Explicit


Sub Macro3()
    Const lngStartRow As Long = 3 'Starting (static) row number for source data. Change to suit
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    Dim lngLastRow As Long
    Dim lngMyRow As Long
    Dim lngPasteRow As Long
     
    Application.ScreenUpdating = False
     
    Set wsSourceTab = Sheets("Sheet1") 'Sheet name for your raw data. Change to suit.
    Set wsOutputTab = Sheets("Sheet3") 'Sheet name for your raw data to be copied to. Change to suit.
     
    lngLastRow = wsSourceTab.Range("F:H").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
    For lngMyRow = 3 To lngLastRow Step 2
        
        If lngPasteRow = 0 Then
            lngPasteRow = 6 'First output row in 'wsOutputTab'
        Else
            lngPasteRow = lngPasteRow + 6
        End If
            
        wsOutputTab.Range("A" & lngPasteRow).Value = wsSourceTab.Range("F" & lngMyRow).Value
        wsOutputTab.Range("B" & lngPasteRow).Value = wsSourceTab.Range("G" & lngMyRow).Value
        wsOutputTab.Range("C" & lngPasteRow).Value = wsSourceTab.Range("H" & lngMyRow).Value
            
        wsOutputTab.Range("D" & lngPasteRow).Value = wsSourceTab.Range("F" & lngMyRow + 1).Value
        wsOutputTab.Range("E" & lngPasteRow).Value = wsSourceTab.Range("G" & lngMyRow + 1).Value
        wsOutputTab.Range("F" & lngPasteRow).Value = wsSourceTab.Range("H" & lngMyRow + 1).Value
            
    Next lngMyRow
     
    Set wsSourceTab = Nothing
    Set wsOutputTab = Nothing
     
    Application.ScreenUpdating = True
     
    MsgBox "Done"
     
End Sub

Display More

A more efficient way may be to have just six tickets (i.e. the number that you have set to fit on a single page) on Sheet3 that after all six have been populated, the page prints. This would solve the problem if you have more records than tickets and you'll have a small defined ticket range to maintain.

Regards,

Robert

**Trebor76** · Jul 17th 2015

Re: Copy range to particular cell repetitively

Quote

A more efficient way may be to have just six tickets (i.e. the number that you have set to fit on a single page) on Sheet3 that after all six have been populated, the page prints. This would solve the problem if you have more records than tickets and you'll have a small defined ticket range to maintain.

Like so:

Code

Option Explicit


Sub Macro4()
    Const lngStartRow As Long = 3 'Starting (static) row number for source data. Change to suit
    
    Dim strMyColumns() As String
    Dim strMyColumn() As String
    Dim lngArrayItem As Long
    
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    Dim lngLastRow As Long
    Dim lngMyRow As Long
    Dim lngOutputRow As Long
    Dim lngMyCount As Long
     
    Application.ScreenUpdating = False
     
    Set wsSourceTab = Sheets("Sheet1") 'Sheet name for your raw data. Change to suit.
    Set wsOutputTab = Sheets("Sheet3") 'Sheet name for your raw data to be copied to. Change to suit.
     
    lngLastRow = wsSourceTab.Range("F:H").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
    For lngMyRow = lngStartRow To lngLastRow
        
        lngMyCount = lngMyCount + 1
    
        'Print every block of six (6) items
        If lngMyCount = 6 Then
            wsOutputTab.PrintOut
            lngMyCount = 0
        End If
        
        'If the 'lngOutputRow' variable has not been set (i.e. it's the macro's first run through), then...
        If lngOutputRow = 0 Then
            '...set it to the first (default) setting of six (6)
            lngOutputRow = 6
        'Else, if the 'lngMyRow' variable is odd, then...
        ElseIf Abs(lngMyRow Mod 2) = 1 Then
            '...increment the 'lngOutputRow' variable by six (6) i.e. the number of tickets per page
            lngOutputRow = lngOutputRow + 6
        End If
        
        'If the 'lngMyRow' variable is odd, then...
        If Abs(lngMyRow Mod 2) = 1 Then
            '...copy the contents of that row variable for columns F, G and H of the 'wsSourceTab' sheet to the 'lngOutput' row variable for columns A, B and C of the 'wsOutputTab' sheet
            strMyColumns = Split("F-A,G-B,H-C", ",")
            For lngArrayItem = 0 To UBound(strMyColumns)
                strMyColumn = Split(strMyColumns(lngArrayItem), "-")
                wsOutputTab.Range(strMyColumn(1) & lngOutputRow).Value = wsSourceTab.Range(strMyColumn(0) & lngMyRow).Value
            Next lngArrayItem
        'Else if the 'lngMyRow' variable is even, then...
        Else
            '...copy the contents of that row variable for columns F, G and H of the 'wsSourceTab' sheet to the 'lngOutput' row variable for columns D, E and F of the 'wsOutputTab' sheet
            strMyColumns = Split("F-D,G-E,H-F", ",")
            For lngArrayItem = 0 To UBound(strMyColumns)
                strMyColumn = Split(strMyColumns(lngArrayItem), "-")
                wsOutputTab.Range(strMyColumn(1) & lngOutputRow).Value = wsSourceTab.Range(strMyColumn(0) & lngMyRow).Value
            Next lngArrayItem
        End If
         
    Next lngMyRow
     
    Set wsSourceTab = Nothing
    Set wsOutputTab = Nothing
     
    Application.ScreenUpdating = True
     
    MsgBox "Done"
     
End Sub

Display More

ginobuonpanino · Jul 17th 2015

Re: Copy range to particular cell repetitively

mmm... interesting... I think that the best way to save paper is to use just a single page with just a single ticket... I can find smaller paper size to fit the output layout. So the macro must populate the first ticket, print, clean the cells and loop... or create empty tickets and then print many times as are the rows with contents in sheet1. I attach a sample file...

**Trebor76** · Jul 17th 2015

Re: Copy range to particular cell repetitively

It's a pity you didn't say this initially as it's the easiest solution by far:

Code

Option ExplicitSub Macro5()




    Const lngStartRow As Long = 3 'Starting (static) row number for source data. Change to suit
     
    Dim wsSourceTab As Worksheet
    Dim wsOutputTab As Worksheet
    Dim lngLastRow As Long
    Dim lngMyRow As Long
     
    Application.ScreenUpdating = False
     
    Set wsSourceTab = Sheets("Sheet1") 'Sheet name for your raw data. Change to suit.
    Set wsOutputTab = Sheets("Sheet3") 'Sheet name for your raw data to be copied to. Change to suit.
     
    lngLastRow = wsSourceTab.Range("F:H").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
    For lngMyRow = lngStartRow To lngLastRow
        wsOutputTab.Range("A7").Value = wsSourceTab.Range("F" & lngMyRow).Value
        wsOutputTab.Range("B7").Value = wsSourceTab.Range("G" & lngMyRow).Value
        wsOutputTab.Range("C7").Value = wsSourceTab.Range("H" & lngMyRow).Value
        wsOutputTab.PrintOut
    Next lngMyRow
     
    Set wsSourceTab = Nothing
    Set wsOutputTab = Nothing
     
    Application.ScreenUpdating = True
     
    MsgBox "Done"
     
End Sub

Display More

Robert

ginobuonpanino · Jul 17th 2015

Re: Copy range to particular cell repetitively

Now works great! Thanks

**Trebor76** · Jul 18th 2015

Re: Copy range to particular cell repetitively

Thanks for letting us know and you're welcome

Copy range to particular cell repetitively

Participate now!

Share