How do I paste sequential blocks of cell values one beneath the next?

[d0rian]

I have a sheet named 'org' that has 50,000 rows of my raw data in columns A and B. I want to extract only certain rows of that data to an existing sheet (titled 'new').

I've managed to write code that identifies the cell ranges I want to extract, but I don't quite know how to actually extract/write the desired ranges. See image below, that's where I'm currently at. So I want to paste the cell range org!A13195:B13238 (that's 47 rows of data) to cell A1 of worksheet 'new'. Then immediately below it (so starting in cell A48 of sheet 'new') I want to paste the values residing in cell range org!A133343:B13372, and so on until I reach the end of the list >> note that list currently contains 7 rows as shown in image below, but it won't always be exactly 7...might be more or less. Thanks in advance for any guidance!

 

[mohadin]

Hi
Try this option
presume the data in your attachment is sheet1

Sub test()
    Dim a, x
    Dim i&
    a = Sheets("Sheet1").Cells(1).CurrentRegion
    For i = 1 To UBound(a)
        x = Split(a(i, 1), "!")
        Sheets(x(0)).Range(x(1)).Copy Sheets("new").Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
    Next
End Sub

BTW the range A13195:B13238 is 44 row not 47

 

[mohadin]

Hi again

Sub test2()
    Dim a, x, b
    Dim i&, ii&
    a = Sheets("Sheet1").Cells(1).CurrentRegion
    ReDim b(1 To UBound(a))
    For i = 1 To UBound(a)
        x = Split(a(i, 1), "!")
        b(i) = Sheets(x(0)).Range(x(1))
    Next
    ii = 0
    For i = 1 To UBound(b)
        Sheets("new").Cells(1, 1).Offset(ii).Resize(UBound(b(i)), 2) = b(i)
        ii = ii + UBound(b(i))
    Next
End Sub

 

[d0rian]

Hi again

Sub test2()
    Dim a, x, b
    Dim i&, ii&
    a = Sheets("Sheet1").Cells(1).CurrentRegion
    ReDim b(1 To UBound(a))
    For i = 1 To UBound(a)
        x = Split(a(i, 1), "!")
        b(i) = Sheets(x(0)).Range(x(1))
    Next
    ii = 0
    For i = 1 To UBound(b)
        Sheets("new").Cells(1, 1).Offset(ii).Resize(UBound(b(i)), 2) = b(i)
        ii = ii + UBound(b(i))
    Next
End Sub

Thank you, this does exactly what I need it to -- and yes, thanks for catching that it was indeed 44 rows in my OP and not 47.

 

[d0rian]

Hi again

Sub test2()
    Dim a, x, b
    Dim i&, ii&
    a = Sheets("Sheet1").Cells(1).CurrentRegion
    ReDim b(1 To UBound(a))
    For i = 1 To UBound(a)
        x = Split(a(i, 1), "!")
        b(i) = Sheets(x(0)).Range(x(1))
    Next
    ii = 0
    For i = 1 To UBound(b)
        Sheets("new").Cells(1, 1).Offset(ii).Resize(UBound(b(i)), 2) = b(i)
        ii = ii + UBound(b(i))
    Next
End Sub

Quick follow-up if you don't mind -- I've been playing around with the code to try and reverse-engineer which line does what so that I can modify it for different situations. I think I've got the 'destination' variable down:

        Sheets("new").Cells(1, 1).Offset(ii).Resize(UBound(b(i)), 2) = b(i)

E.g. seems like "new" dictates the destination sheet, and (1, 1) is the destination's (row, column) cell range.

But I'm a little stuck on how/where I can customize the location of the input ranges, i.e. the ranges I want to sequentially paste. In my OP, those inputs were in A1:A7 of 'Sheet1'. But what if they're, say, in cells R4:R14 as in the image below (with unrelated data in adjoining cells). Which lines of your code above indicate that that's where the code should look for the ranges it should go grab? Thank you again for the help!

 

[mohadin]

Hi
Thank you for the feedback
So
Then line of the code to grab the input data in sheet1 column A (This presume that the data are in one column)

 a = Sheets("Sheet1").Cells(1).CurrentRegion

For the case shown in your image
replace the above mentioned line code with

 With Sheets("sheet1")
        a = Range(.Range("R4"), .Range("R4").End(xlDown))
  End With

Or (Same thing)

 With Sheets("sheet1")
        a = Range(.Cells(4, 18), .Cells(4, 18).End(xlDown))
 End With

or even can use

 With Sheets("sheet1")
         a = .Cells(4, 18).Resize(.Cells(Rows.Count, 18).End(xlUp).Row - 3)
    End With

Cells(4,18) = Range("R4")