Paste Values via VB Q

J

John

I have a list of values in cells that I want to paste to a new worksheet,
however these values are not on either the same Row or column, but I want
the 'output' worksheet to be in the format

A1 = Value1; B1 = Value2; C1 = Value3; D1 = Value4
A2 = Value5; B1 = Value6; C1 = Value7; D1 = Value8

The layout of the above values in the 'source' worksheet is as follows

A1 = Value1; B1 = Value2; I20 = Value3; J20 = Value4
A23 = Value5; B23 = Value6; I42 = Value7; J42 = Value8

As you can see there is a set gap in rows between each of my 'segments' of
data. Values to 'output' worksheet should be pastespecial values, as the
source are formulated.

Thanks
 
T

Tom Ogilvy

Sub Tester3()
varr = Evaluate("{""A1"",""A1"";""B1"",""B1"";" & _
"""C1"",""I20"";""D1"",""J20"";" & _
"""A2"",""A23"";""B2"",""B23"";" & _
"""C2"",""I42"";""D2"",""J42""}")
For i = LBound(varr, 1) To UBound(varr, 1)
Worksheets("Sheet2").Range(varr(i, UBound(varr, 2))).Value = _
Worksheets("Sheet1").Range(varr(i, LBound(varr, 2))).Value
Next
End Sub
 
R

Ron de Bruin

Or use functions in the range A100:D101 (you can hide the two rows if you want)
in A100 =A1, in B100 =B1, in C100 =I20, in D100 =J20
And in row 101 your other 4 cells

You can use this macro then

Sub test()
Sheets("Sheet2").Range("A1:D2").Value = _
Sheets("Sheet1").Range("A100:D101").Value
End Sub
 
J

John

Thanks Tom for your reply

Problem with this code is that I would have to hard type all ranges in - I'm
likely to have approx 150 'ranges' which I will have to paste

Is it possible to specify a 'Start' cell in each column and then Jump down
22 cells to the next 'source cell, continue this in the same column until
there are no values left,then move to Column B and do the same etc?
 
T

Tom Ogilvy

Dim rng as Range, rng1 as Range
Dim i as Long
With Worksheets("SheetSource")
for i = 1 to 4
set rng = .Range(.Cells(1,i),.Cells(rows.count,i).End(xlup))
set rng1 = rng.SpecialCells(xlBlanks)
rng.EntireRow.Hidden = True
rng.Copy Destination:=Worksheets("SheetDest").Cells(1,i)
rng1.EntireRow.Hidden = False
Next i
End with
 
T

Tom Ogilvy

Let's see, I guess you didn't say the cells in between were empty or that
they started in row 1. Try this instead:

Sub Tester9()
Dim i As Long, j As Long, k As Long, l As Long
Dim rng As Range, cell As Range
With Worksheets("SheetSource")
Set rng = Union(.Range("A1"), .Range("B1"), .Range("I20"), .Range("J20"))

i = 0
j = 0
l = 0
For Each cell In rng
j = cell.Row
k = 1
l = l + 1
Do While Not IsEmpty(.Cells(j, cell.Column))
Cells(j, cell.Column).Copy Destination:=Worksheets("SheetDest") _
.Cells(k, l)
k = k + 1
j = j + 22
Loop
Next
End With
 
J

John

Thanks again for your reply Tom. I'm hitting a Debug on "With
Worksheets("SheetSource")" - it says invalid outside procedure
 
J

John

Scrub my last post, I took your latest code and substituted with cell Refs
as follows.........

Sub Tester9()
Dim i As Long, j As Long, k As Long, l As Long
Dim rng As Range, cell As Range
With Worksheets("Recipes")
Set rng = Union(.Range("A9"), .Range("B9"), .Range("I28"), .Range("J28"))

i = 0
j = 0
l = 0
For Each cell In rng
j = cell.Row
k = 1
l = 1 + 1
Do While Not IsEmpty(.Cells(j, cell.Column))
Cells(j, cell.Column).Copy Destination:=Worksheets("Sheet1") _
.Cells(k, l)
k = k + 1
j = j + 22
Loop
Next
End With

End Sub

It only works correct for Column J, no other values are pasted. There is
blank cells in A10:B30, so the next data that I need that follows A9:B9 is
in A31:B31

Also don't need anything in C*:H* (although there are values in it). Then I
need I28:K28, then following that the next values (for those columns) are in
I50:K50

Thanks for your time
 
T

Tom Ogilvy

You changed an "l" (el) to a 1 (one).

one of the Cells did not have the dot - so it only worked correctly if
recipes was the active sheet. Not sure if that was my omission or it got
plucked off by the mail program, but here is a corrected version.

Sub Tester9()
Dim i As Long, j As Long, k As Long, l As Long
Dim rng As Range, cell As Range
With Worksheets("Recipes")
Set rng = Union(.Range("A9"), .Range("B9"), .Range("I28"), .Range("J28"))

i = 0
j = 0
l = 0
For Each cell In rng
j = cell.Row
k = 1
l = l + 1
Do While Not IsEmpty(.Cells(j, cell.Column))
.Cells(j, cell.Column).Copy Destination:= _
Worksheets("Sheet1") _
.Cells(k, l)
k = k + 1
j = j + 22
Loop
Next
End With
End Sub


If you want I:K then do this

Set rng = Union(.Range("A9"), .Range("B9"), _
.Range("I28"), .Range("J28"), .Range("K28"))
 
J

John

Tom, virtually works like a dream, the only thing I need it to do now is
paste-special-values for all 4 columns, I can't see where I would put this
in the code

Thanks again for your time
 
T

Tom Ogilvy

Sub Tester9()
Dim i As Long, j As Long, k As Long, l As Long
Dim rng As Range, cell As Range
With Worksheets("Recipes")
Set rng = Union(.Range("A9"), .Range("B9"), .Range("I28"), .Range("J28"))

i = 0
j = 0
l = 0
For Each cell In rng
j = cell.Row
k = 1
l = l + 1
Do While Not IsEmpty(.Cells(j, cell.Column))
.Cells(j, cell.Column).Copy
Worksheets("Sheet1")
.Cells(k, l).PasteSpecial xlValues
k = k + 1
j = j + 22
Loop
Next
End With
End Sub
 
J

John

Tom, many thanks again for taking the trouble to post

I'm getting an "invalid use of property" at line "Worksheets ("Sheet1")"

I notice that from your previous post that the code just before this that
said "Destination:= _" was not in this one, I put it in but still had a
debug error

Thanks
 
J

John

Tom got it to work - thanks I owe you a drink


John said:
Tom, many thanks again for taking the trouble to post

I'm getting an "invalid use of property" at line "Worksheets ("Sheet1")"

I notice that from your previous post that the code just before this that
said "Destination:= _" was not in this one, I put it in but still had a
debug error

Thanks


empty = is
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top