Copy Paste until blank

RRM1 · Jun 14th 2020

Hi, this is a request for a new sub routine. I've attached a template for the steps and dummy data that I would like to simulate.

I have multiple columns of random data (3 rows each) from columns N to column T or at least until there is an empty column range in sheet1. I want to copy and paste the first column data ( 3 rows) in column N and paste it to say sheet 1, cell C5 then my model runs until a condition is met and paste results in the next sheet2. Once that condition is met, then I want to get next column data (3 rows) from column N and paste over the data in cell C5 and the model runs until same condition is met again etc. This goes on until a blank column is met in sheet1 then stops.

Thanks in advance.

dangelor · Jun 15th 2020

This will copy each set of numbers to a sheet, adding the sheet if needed...

Code

Sub Test()
    Dim i As Long, lCol As Long
    With Sheet1
        lCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
        For i = 1 To lCol - 13
            Do
                DoEvents
                Application.Calculate
            Loop Until .Cells(1, 1).Value = "True"
            If Sheets.Count < i Then Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(i).Range("C5:C7").Value = .Range("M5:M7").Offset(, i).Value
        Next i
    End With
End Sub

Display More

RRM1 · Jun 16th 2020

Thanks for the feedback. I tried to manipulate your code to generate the range of numbers in sheet 2 only as a sequence as how they were displayed in sheet 1, once the condition is met but, I failed.

What I want to achieve is to copy the range of numbers in each column starting from sheet 1, column N5:N7 then paste it into column C, C5:C7. Once the condition is TRUE looking at sheet 1, A1 then this range of numbers are value pasted into sheet 2, A1:A3. The iteration starts over again and moves to the next column in sheet 1, that is O5:O7 and does the same thing by pasting in C5:C7 this range of numbers and once the condition is met then it value paste that range into sheet 2, B1:B3 etc. This continues for each column of data until a blank column is met in sheet 1. The code ends then.

I failed to modify your code. I want to achieve pasting each separate column range of numbers in sheet 2 only as a sequence to each other and and also to ensure the condition set is a reflection of each range of numbers pasted into sheet 1, C11. Hope this is clearer or at least let me know. Thanks in advance. My failed attempt at code below

Code

1.     Sub Test()
2.         Dim i As Long, lCol As Long
3.         With Sheet1
4          lCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
5.         For i = 1 To lCol - 13
6.         Do
7.         DoEvents
8.         Application.Calculate
9.         Sheet1.Range("N5:N7").Copy Sheet1.Range("C5:C7").Offset(, i)
10.        Loop Until .Cells(1, 1).Value = "True"
11.        Sheet2.Cells.Range("C5:C7").Value = Sheet1.Range("M5:M7").Offset(, i).Value
12.        Next i
13         End With
14.    End Sub

Display More

dangelor · Jun 17th 2020

Code

Sub Test2()
    Dim i As Long, lCol As Long
    With Sheet1
        lCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
        For i = 1 To lCol - 13
            Do
                DoEvents
                Application.Calculate
            Loop Until .Cells(1, 1).Value = "True"
            If Sheets.Count < i Then Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(1).Range("C5:C7").Value = .Range("M5:M7").Offset(, i).Value
            If i > 1 Then Sheets(i).Range("A1:A3").Value = .Range("M5:M7").Offset(, i).Value
        Next i
    End With
End Sub

Display More

RRM1 · Jun 17th 2020

Solved. I took your code and re-modified it to value paste the series of data into sheet 2, as a sequence once the condition is met. This gives me the desired outcome. Thanks again for your guidance.

Code

Sub Test2()
 Dim i As Long, lCol As Long
 With Sheet1
 lCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
 For i = 1 To lCol - 13
 Do
 DoEvents
 Application.Calculate
 Loop Until .Cells(1, 1).Value = "True"
 Sheets(1).Range("C5:C7").Value = .Range("M5:M7").Offset(, i).Value
 If i > 1 Then Sheets(2).Range("A1:A3").Offset(0, i).Value = Sheets(1).Range("M5:M7").Offset(0, i).Value
 Next i
 End With
End Sub

Display More

dangelor · Jun 17th 2020

You're welcome!

Justin Doward · Jun 18th 2020

HI RR,

This code works but starts on sheet 2 at B1, you can change to start pasting in A1 with an if function if necessary. To test it I changed your if function in A1 to read =if(C11 > C10, TRUE, "") then put a number in C10 that would cause some false results.

Code

Sub ConditionMet()
Application.ScreenUpdating = False
Dim i As Long, j As Long, CLs As Long, CLs2 As Long
Dim MyArr As Variant
Dim ws1 As Worksheet: Set ws1 = Sheet1
Dim ws2 As Worksheet: Set ws2 = Sheet2


CLs = ws1.Range("N5").End(xlToRight).Column


MyArr = ws1.Range("N5").Resize(3, CLs - 13)


For i = LBound(MyArr, 2) To UBound(MyArr, 2)
For j = LBound(MyArr, 1) To UBound(MyArr, 1)
ws1.Range("C" & 4 + j) = MyArr(j, i)
Next j
If ws1.Range("A1").Value = True Then
CLs2 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column + 1
For j = LBound(MyArr, 1) To UBound(MyArr, 1)
ws2.Cells(j, CLs2) = MyArr(j, i)
Next j
End If
Next i


End Sub

Display More

Justin Doward · Jun 18th 2020

Not sure what happened sorry, I wrote the post above last week but it got stuck as a draft. It looks like dangelors code is more efficient anyway.

RRM1 · Jun 19th 2020

Justin, thanks for showing me an alternative at least.

Copy Paste until blank

Participate now!

Share

Tags