Home » excel » excel – How to copy some range in loop to right direction?

excel – How to copy some range in loop to right direction?

Posted by: admin May 14, 2020 Leave a comment

Questions:

I try to copy some range (table) to the right direction, but I have a problem, because right direction is characters. My function gets amount of copies and amount of rows in a table (table range is dynamic).

Function DrawBorder(Rows As Long, Amount As Long)

    Dim rng As Range
    Dim WS As Worksheet
    Dim firstRow As Long
    Dim firstCol As Long
    Dim lastRow As Long
    Dim lastCol As Long

    Let firstRow = 2
    Let firstCol = 2
    Let lastRow = Rows + 2
    Let lastCol = 4

    Set WS = Sheets("Sheet1")
    Set rng = WS.Range("B" & firstRow & ":" & "D" & lastRow)

    'Borders of the cells inside the range
    rng.Borders.LineStyle = xlContinuous

    'Border of the range as a whole with double lines
    rng.Borders(xlEdgeTop).LineStyle = xlContinuous
    rng.Borders(xlEdgeTop).Weight = xlThick
    rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
    rng.Borders(xlEdgeBottom).Weight = xlThick
    rng.Borders(xlEdgeLeft).LineStyle = xlContinuous
    rng.Borders(xlEdgeLeft).Weight = xlThick
    rng.Borders(xlEdgeRight).LineStyle = xlContinuous
    rng.Borders(xlEdgeRight).Weight = xlThick

   ' Paste to multiple destinations
   rng.Copy Destination:=Sheet1.Range("F" & firstRow & ":" & "H" & lastRow)
   rng.Copy Destination:=Sheet1.Range("J" & firstRow & ":" & "L" & lastRow)
   rng.Copy Destination:=Sheet1.Range("N" & firstRow & ":" & "P" & lastRow)
   rng.Copy Destination:=Sheet1.Range("R" & firstRow & ":" & "T" & lastRow)

End Function

I want to do this in loop, but I don’t know how to increment destination of columns.

This is what I need:

Imgur

Final loop, that I use:

Dim i As Long
For i = 0 To Amount - 1 'copy "Amount" times
    rng.Copy Destination:=rng.Offset(ColumnOffset:=4 * i)
Next i

Thaks to all!

How to&Answers:

Use a loop in combination with the Range.Offset property to “move”/offset your range.

Giving you one example:

Dim i As Long
For i = 1 to Amount 'copy "Amount" times
    'your code here

    rng.Copy Destination:=Sheet1.Range("F" & firstRow & ":" & "H" & lastRow).Offset(ColumnOffset:=4 * i))
Next i

Answer:

You can try below code. It’s enought to loop desired amount of times, each time setting proper range to draw border around:

Sub DrawBorder()
    'Your input data
    Dim rows As Long: rows = 10
    Dim amount As Long: amount = 10
    'I guess those will be constants
    Dim columns As Long: columns = 2
    Dim firstRow As Long: firstRow = 2
    Dim firstColumn As Long: firstColumn = 2

    Dim rng As Range

    For i = 0 To amount - 1

        Set rng = Range(Cells(firstRow, firstColumn + i * (columns + 2)), Cells(firstRow + rows, firstColumn + columns + i * (columns + 2)))
        'Border of the range as a whole with double lines
        rng.Borders(xlEdgeTop).LineStyle = xlContinuous
        rng.Borders(xlEdgeTop).Weight = xlThick
        rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
        rng.Borders(xlEdgeBottom).Weight = xlThick
        rng.Borders(xlEdgeLeft).LineStyle = xlContinuous
        rng.Borders(xlEdgeLeft).Weight = xlThick
        rng.Borders(xlEdgeRight).LineStyle = xlContinuous
        rng.Borders(xlEdgeRight).Weight = xlThick

    Next
End Sub

Answer:

Draw Borders

Links

Workbook Download

The Code

Sub DrawBorders(Rows As Long, Optional Amount As Long = 1, _
        Optional ColumnsInBetween As Long = 1)

    Const cSheet As Variant = "Sheet1"  ' Worksheet Name/Index
    Const firstRow As Long = 2          ' First Row Number
    Const firstCol As Variant = "B"     ' First Column Letter/Number
    Const lastCol As Variant = "D"      ' Last Column Letter/Number
    Const colBetween As Long = 1        ' Columns Between Ranges

    Dim rng As Range        ' Current Range
    Dim noCols As Long      ' Number of Columns
    Dim i As Long           ' Amount Counter
    Dim j As Long           ' Inside Borders Counter

    With ThisWorkbook.Worksheets(cSheet)
        noCols = .Cells(1, lastCol).Column - .Cells(1, firstCol).Column + 1
        For i = 0 To Amount - 1
            Set rng = .Cells(firstRow, .Cells(firstRow, firstCol) _
                    .Column + (noCols + ColumnsInBetween) * i)
                    .Resize(Rows, noCols)
            With rng
                ' Default:  xlContinuous, xlThin, xlColorIndexAutomatic
                .BorderAround , xlThick
                For j = 11 To 12
                    With .Borders(j)
                         .LineStyle = xlContinuous
                    End With
                Next
             End With
         Next
     End With
End Sub

Usage

BEFORE

enter image description here

Sub DrawExample()

    DrawBorders 20, 6

End Sub

AFTER

enter image description here