How to increment a column with a selected range

[crthompson1]

Hello,

I am trying to copy the data (C6:C78) from an excel spreadsheet Sheet1 and copy it to (C6:C78) in Sheet3. I then want to copy the data from (C6:C78) Sheet2 and copy it to the range (D678) on Sheet3. I then want to copy (D678) from Sheet1 to (E6:E78) on Sheet3. I would then like to copy (D678) from Sheet2 to (F6:F78) on Sheet3 and the pattern continues. How would I increment only the column letter (sometimes the increment is by 1 and sometimes it is by 2) in SourceRange1, SourceRange2, & DestinationRange? The column letters would both need to be incremented such as (C6:C78) becomes (D678) and (C6:C78) becomes (E6:E78). I hope my question makes sense...

Thanks in advance!! My code is listed below:

Dim N As Integer
    Dim SourceRange1 As Range
    Dim SourceRange2 As Range
    Dim DestinationRange As Range
    N = 0
    
    'Set the starting copy ranges for sheet1 & sheet2
    'Set the starting paste range for sheet3
    SourceRange1 = "C6:C78"
    SourceRange2 = "C6:C78"
    DestinationRange = "C6:C78"
    Do Until N = 13
    
    'Cut the first column of data from sheet1 and paste it into the first column of data in sheet3
    'Cut 1
    'Set0,6,12,18,24,30,36,42,48,54,60,66,72
    Sheets("Sheet1").Select
    Range(SourceRange1).Select
    Selection.Cut
    SourceRange1 = SourceRange1 + 2
    'Paste 1
    Sheets("Sheet7").Select
    Range(DestinationRange).Select
    ActiveSheet.Paste
    DestinationRange = DestinationRange + 1
    'Cut the first column of data from sheet2 and paste it into the second column of data in sheet3
    'Cut 2
    'Set0,6,12,18,24,30,36,42,48,54,60,66,72
    Sheets("Sheet2").Select
    Range(SourceRange2).Select
    Selection.Cut
    SourceRange2 = SourceRange2 + 2
    'Paste 2
    Sheets("Sheet7").Select
    Range(DestinationRange).Select
    ActiveSheet.Paste
    DestinationRange = DestinationRange + 1
    'Cut the second "used" column of data from sheet1 and paste it into the third column of data in sheet3
    'Cut 1
    'Set2,8,14,20,26,32,38,44,50,56,62,68,74
    Sheets("Sheet1").Select
    Range(SourceRange1).Select
    Selection.Cut
    SourceRange1 = SourceRange1 + 1
    'Paste 1
    Sheets("Sheet7").Select
    Range(DestinationRange).Select
    ActiveSheet.Paste
    DestinationRange = DestinationRange + 1
    'Cut the second "used" column of data from sheet2 and paste it into the fourth column of data in sheet3... This pattern continues...
    'Cut 2
    'Set2,8,14,20,26,32,38,44,50,56,62,68,74
    Sheets("Sheet2").Select
    Range(SourceRange2).Select
    Selection.Cut
    SourceRange2 = SourceRange2 + 1
    'Paste 2
    Sheets("Sheet7").Select
    Range(DestinationRange).Select
    ActiveSheet.Paste
    DestinationRange = DestinationRange + 1
    'Cut 1
    'Set3,9,15,21,27,33,39,45,51,57,63,69,75
    Sheets("Sheet1").Select
    Range(SourceRange1).Select
    Selection.Cut
    SourceRange1 = SourceRange1 + 1
    'Paste 1
    Sheets("Sheet7").Select
    Range(DestinationRange).Select
    ActiveSheet.Paste
    DestinationRange = DestinationRange + 1
    'Cut 2
    'Set3,9,15,21,27,33,39,45,51,57,63,69,75
    Sheets("Sheet2").Select
    Range(SourceRange2).Select
    Selection.Cut
    SourceRange2 = SourceRange2 + 1
    'Paste 2
    Sheets("Sheet7").Select
    Range(DestinationRange).Select
    ActiveSheet.Paste
    DestinationRange = DestinationRange + 1
    'Cut 1
    'Set4,10,16,22,28,34,40,46,52,58,64,70,76
    Sheets("Sheet1").Select
    Range(SourceRange1).Select
    Selection.Cut
    SourceRange1 = SourceRange1 + 2
    'Paste 1
    Sheets("Sheet7").Select
    Range(DestinationRange).Select
    ActiveSheet.Paste
    DestinationRange = DestinationRange + 1
    'Cut 2
    'Set4,10,16,22,28,34,40,46,52,58,64,70,76
    Sheets("Sheet2").Select
    Range(SourceRange2).Select
    Selection.Cut
    SourceRange2 = SourceRange2 + 2
    'Paste 2
    Sheets("Sheet7").Select
    Range(DestinationRange).Select
    ActiveSheet.Paste
    DestinationRange = DestinationRange + 1
    
    N = N + 1
    
    Loop

[p45cal]

This picture is of Sheet7, the result of running an adaptation of your code:
The blue text is the result of the first iteration of your loop, the black text is the second iteration of the loop.
Note the jump in two columns of the source data (C to E) in destination (Sheet7) columns D to E.
The same in the second iteration where source data jumps from column i to column K in sheet7's columns L to M
2018-08-29_224007.jpg
If this pattern is wrong, supply a workbook with a similar Sheet7 with a row filled in in the same way for the whole lot, so that I can see where every column in Sheet7 gets its data from.

[crthompson1]

This picture is of Sheet7, the result of running an adaptation of your code:
The blue text is the result of the first iteration of your loop, the black text is the second iteration of the loop.
Note the jump in two columns of the source data (C to E) in destination (Sheet7) columns D to E.
The same in the second iteration where source data jumps from column i to column K in sheet7's columns L to M
2018-08-29_224007.jpg
If this pattern is wrong, supply a workbook with a similar Sheet7 with a row filled in in the same way for the whole lot, so that I can see where every column in Sheet7 gets its data from.

That pattern is correct. I'm sure it looks strange, but I'm trying to alternate extracting certain columns in a repeating pattern from two different sheets and paste them into sheet7 in consecutive order. The pattern increases 2 cells after the first column, 1 cell after the second, 1 cell after the third, and 2 cells after the fourth. Then the pattern repeats.

[Paul_Hossler]

I used arySet generation, but the source columns can be automated to use how ever many columns there are, but this is the gist of it

No need to .Select the sheet or the range

Option Explicit
Sub test()
    Dim arySet As Variant
    Dim i As Long, o As Long
    
    arySet = Array(3, 5, 6, 7, 9, 11, 12, 13)
    
    o = 3
    
    'change the .Copy to .Cut <<<<<<<<<<<<<<<<<<<<<<
    For i = LBound(arySet) To UBound(arySet)
        Worksheets("Sheet1").Cells(6, arySet(i)).Resize(73, 1).Copy _
            Worksheets("Sheet7").Cells(6, o)
        o = o + 1
        Worksheets("Sheet2").Cells(6, arySet(i)).Resize(73, 1).Copy _
            Worksheets("Sheet7").Cells(6, o)
        o = o + 1
    
    Next i
End Sub

or something along these lines.

Sub test2()

    Dim i As Long, o As Long, n As Long, s As Long
    Dim A As Variant
    
    A = Array(2, 1, 1, 2)   '   increment array
    o = 3                   '   output col
    i = -1                  '   increment array index
    s = 3                   '   source column
    
    'change the .Copy to .Cut
    For n = 1 To 13
        Worksheets("Sheet1").Cells(6, s).Resize(73, 1).Copy _
            Worksheets("Sheet7").Cells(6, o)
        o = o + 1
            
        Worksheets("Sheet2").Cells(6, s).Resize(73, 1).Copy _
            Worksheets("Sheet7").Cells(6, o)
        o = o + 1
    
        i = i + 1
        If i > UBound(A) Then i = LBound(A)
    
        s = s + A(i)
    
    
    Next n
End Sub

[p45cal]

Paul's beaten me to it. Please feed back to say how you're getting on.
Paul, I'm doubtful you can change .Copy to .Cut (unless you activate the destination sheet and select the destination cell), I think you need to stay with .Copy but add a line each time of the ilk:
Worksheets("Sheet1").Cells(6, s).Resize(73, 1).ClearContents

[Paul_Hossler]

@p45cal --


https://docs.microsoft.com/en-us/off...6)%26rd%3Dtrue


Seems to work. The attachment is the results after running the second macro version

[p45cal]

Yes Paul, you're quite right. I don't know what gave me that impression!
Thanks.

[crthompson1]

I used arySet generation, but the source columns can be automated to use how ever many columns there are, but this is the gist of it

No need to .Select the sheet or the range

Option Explicit
Sub test()
    Dim arySet As Variant
    Dim i As Long, o As Long
    
    arySet = Array(3, 5, 6, 7, 9, 11, 12, 13)
    
    o = 3
    
    'change the .Copy to .Cut <<<<<<<<<<<<<<<<<<<<<<
    For i = LBound(arySet) To UBound(arySet)
        Worksheets("Sheet1").Cells(6, arySet(i)).Resize(73, 1).Copy _
            Worksheets("Sheet7").Cells(6, o)
        o = o + 1
        Worksheets("Sheet2").Cells(6, arySet(i)).Resize(73, 1).Copy _
            Worksheets("Sheet7").Cells(6, o)
        o = o + 1
    
    Next i
End Sub

or something along these lines.

Sub test2()

    Dim i As Long, o As Long, n As Long, s As Long
    Dim A As Variant
    
    A = Array(2, 1, 1, 2)   '   increment array
    o = 3                   '   output col
    i = -1                  '   increment array index
    s = 3                   '   source column
    
    'change the .Copy to .Cut
    For n = 1 To 13
        Worksheets("Sheet1").Cells(6, s).Resize(73, 1).Copy _
            Worksheets("Sheet7").Cells(6, o)
        o = o + 1
            
        Worksheets("Sheet2").Cells(6, s).Resize(73, 1).Copy _
            Worksheets("Sheet7").Cells(6, o)
        o = o + 1
    
        i = i + 1
        If i > UBound(A) Then i = LBound(A)
    
        s = s + A(i)
    
    
    Next n
End Sub

Thanks for the response! I couldn't do an array because the amount of columns I would be copying won't be the same each time. I used the following to get my column number to increment in the pattern I wanted.

    'Cut the first column of data from sheet1 and paste it into the first column of data in sheet7
    'Cut 1
    'Set0,6,12,18,24,30,36,42,48,54,60,66,72
X=0
Do Until X=10
    Sheets("Sheet1").Select
    SourceRange1.Select
    SourceRange1.Copy
    Sheets("Sheet7").Select
    DestinationColumn.Select
    ActiveSheet.Paste
    Source1ColumnNumber = Source1ColumnNumber + 2
    Sheets("Sheet1").Select
    Set SourceRange1 = Sheets(1).Range(Cells(6, Source1ColumnNumber), Cells(78, Source1ColumnNumber))
    DestinationColumnNumber = DestinationColumnNumber + 1
    Sheets("Sheet7").Select
    Set DestinationColumn = Sheets(7).Range(Cells(6, DestinationColumnNumber), Cells(78, DestinationColumnNumber))

    Sheets("Sheet1").Select
    SourceRange1.Select
    SourceRange1.Copy
    Sheets("Sheet7").Select
    DestinationColumn.Select
    ActiveSheet.Paste
    Source1ColumnNumber = Source1ColumnNumber + 1
    Sheets("Sheet1").Select
    Set SourceRange1 = Sheets(1).Range(Cells(6, Source1ColumnNumber), Cells(78, Source1ColumnNumber))
    DestinationColumnNumber = DestinationColumnNumber + 1
    Sheets("Sheet7").Select
    Set DestinationColumn = Sheets(7).Range(Cells(6, DestinationColumnNumber), Cells(78, DestinationColumnNumber))

    Sheets("Sheet1").Select
    SourceRange1.Select
    SourceRange1.Copy
    Sheets("Sheet7").Select
    DestinationColumn.Select
    ActiveSheet.Paste
    Source1ColumnNumber = Source1ColumnNumber + 1
    Sheets("Sheet1").Select
    Set SourceRange1 = Sheets(1).Range(Cells(6, Source1ColumnNumber), Cells(78, Source1ColumnNumber))
    DestinationColumnNumber = DestinationColumnNumber + 1
    Sheets("Sheet7").Select
    Set DestinationColumn = Sheets(7).Range(Cells(6, DestinationColumnNumber), Cells(78, DestinationColumnNumber))

    Sheets("Sheet1").Select
    SourceRange1.Select
    SourceRange1.Copy
    Sheets("Sheet7").Select
    DestinationColumn.Select
    ActiveSheet.Paste
    Source1ColumnNumber = Source1ColumnNumber + 2
    Sheets("Sheet1").Select
    Set SourceRange1 = Sheets(1).Range(Cells(6, Source1ColumnNumber), Cells(78, Source1ColumnNumber))
    DestinationColumnNumber = DestinationColumnNumber + 1
    Sheets("Sheet7").Select
    Set DestinationColumn = Sheets(7).Range(Cells(6, DestinationColumnNumber), Cells(78, DestinationColumnNumber))
X=X+1
Loop

[Paul_Hossler]

1. Use CODE tags please -- the [#] icon will insert opening and closing CODE tags and you can paste your macro between them

2. You don't need to do all that .Select and Set to just Cut some data over

3. It seems you change the number of iterations each time:in post #1 it was 13, in post #8 it was 10

I think if you use test2() and manually change the 13 to 10, it should be the same

If the data on sheet1 and sheet2 is a contiguous block, there are more sophisticated ways to do it so that you don't need to manually update the macro