Sub to iterate thru combo box n copy paste n name ranges successively in a new sht

[Max]

Sorry, I'm posting this query again as there was an OE error received just
now
----------------
In a sheet: Z

I have a
Defined range: Branch
which refers to: =Z!$B$2:$V$10

I have a combo box (from control toolbox), with
Linked cell: H3
ListFillRange: BrList2
where BrList2 ='R'!$A$2:$A$86

The combo box selection (linked to H3) drives several formulas within Branch

I would like to iterate through each text value in BrList2, copy Branch then
paste special as values & as formats starting at B2 in a new sheet, leaving
a blank single row in-between successive copy/pastes of Branch for each
value in BrList2. The 1st paste will go into B2: V10, 2nd paste goes into
B12:V20, and so on down the sheet

I would also need each pasted range in the new sheet to be named after the
corresponding value in BrList2.
Eg: if 1st value in BrList2 is xx1, then the 1st paste done in B2:V10 will
be named: xx1

Thanks for help with a sub which can automate the above generation.

 

[Max]

Any help?

I'm dropping the naming bit

I'm also prepared to just use a DV in H3 instead of the combo box

Could someone help with a sub which can do the copy n paste part?:
-----------------
I would like to iterate through each text value in BrList2, copy Branch then
paste special as values & as formats starting at B2 in a new sheet, leaving
a blank single row in-between successive copy/pastes of Branch for each
value in BrList2. The 1st paste will go into B2:V10, 2nd paste goes into
B12:V20, and so on down the sheet
-----------------
Branch is a defined range
which refers to: =Z!$B$2:$V$10

BrList2 is another defined range used in the DV/combo box
which refers to: ='R'!$A$2:$A$86

Each text value within BrList2 (which are the branch names) will output a
different set of results in the range Branch

Thanks ..

 

[Dave Peterson]

I'm not sure you gave enough info--or I couldn't pick it out <bg>.

But maybe this will give you a start:

dim myCell as range
dim myRng as range
dim RngToCopy as range
dim DestCell as range

set destcell = worksheets.add.range("B2")

with worksheets("r")
set myrng = .range("A2:A86")
'or
'set myrng = .range("a2",.cells(.rows.count,"A").end(xlup))
end with

with worksheets("youdidn'tsharethenameorimissedit")
for each mycell in myrng.cells
.range("H3").value = mycell.value
set rngtocopy = .range("Youdidn'tsaywhatshouldbecopied--or I missed it")
rngtocopy.copy
destcell.pastespecial paste:=xlpastevalues
destcell.pastespecial paste:=xlpasteformats '???
set destcell = destcell.offset(10,0)
next mycell
end with

====
Untested, uncompiled <vvbg>

 

[Max]

Dave, just a quick note to say thanks for your response
Will try it out in office & feedback further here
Gotta leave for work now ...

 

[Dave Peterson]

Whew!

Safe for a few hours!

Dave, just a quick note to say thanks for your response
Will try it out in office & feedback further here
Gotta leave for work now ...

 

[Max]

Dave,
Many thanks. Tinkered around a little with the code you offered, it works
well (sub below).
I experimented with the recorder & added these 2 lines below (besides the
xlPasteColumnWidths line) as I realized that there was a floating picture (a
legend) within the range Branch which needed to be pasted over as well
(paste special doesn't paste the pic)
DestCell.Select
ActiveSheet.Paste
Would like your expert eye if the above additions are ok as-is (it seems to
work ok),
or, if there's a better way that it should be done
--------------
Sub Gen()
Dim myCell As Range
Dim myRng As Range
Dim RngToCopy As Range
Dim DestCell As Range

Set DestCell = Worksheets.Add.Range("B2")

With Worksheets("r")
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With Worksheets("Z")
For Each myCell In myRng.Cells
.Range("H3").Value = myCell.Value
Set RngToCopy = .Range("Branch")
RngToCopy.Copy
DestCell.Select
ActiveSheet.Paste
DestCell.PasteSpecial Paste:=xlPasteValues
DestCell.PasteSpecial Paste:=xlPasteFormats
DestCell.PasteSpecial Paste:=xlPasteColumnWidths
Set DestCell = DestCell.Offset(10, 0)
Next myCell
End With

End Sub

 

[Dave Peterson]

Untested...

dim myPict as picture 'is it really a picture


With Worksheets("r")
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
set mypict = .pictures("picturenamehere")
End With

Then you can use:

mypict.copy
destcell.parent.paste

And then position it where you want usint .top, .left stuff.

 

[Dave Peterson]

Here's one that's a little more fleshed out (er, tested):

Option Explicit
Sub testme()

Dim myPict As Picture
Dim myNewPict As Picture

With Worksheets("sheet1")
Set myPict = .Pictures("Picture 1")
End With

With Worksheets.Add
myPict.Copy
.Paste
'the last picture added is what I want
'if it's the only picture, I could have used .pictures(1)
'but that could mess me up when I copy the code to a differet project
Set myNewPict = .Pictures(.Pictures.Count)
End With

With myPict
myNewPict.Top = .Top
myNewPict.Left = .Left
End With

End Sub

 

[Max]

Dave, thanks for your responses.

The picture is: Picture 3 in sheet: Z
This pic floats over cell M6 which is within the range Branch to be
copied/pasted

Tried fitting in your code (shown below), but couldn't quite get it right

In the new sheet, the pic does get copy/pasted with each iteration but the
pastes are not in the correct position. The pastes all seem to be somewhere
just below the top left cell in the pasted ranges, eg C3, C13, and so on.
The correct positions should be over M6, M16, etc

------------------
Sub Generate()
Dim myCell As Range
Dim myRng As Range
Dim RngToCopy As Range
Dim DestCell As Range
Dim myPict As Picture
'Dim myNewPict As Picture

Set DestCell = Worksheets.Add.Range("B2")

With Worksheets("r")
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With Worksheets("Z")
For Each myCell In myRng.Cells
.Range("H3").Value = myCell.Value
Set RngToCopy = .Range("Branch")
RngToCopy.Copy

'DestCell.Select
'ActiveSheet.Paste
DestCell.PasteSpecial Paste:=xlPasteValues
DestCell.PasteSpecial Paste:=xlPasteFormats
DestCell.PasteSpecial Paste:=xlPasteColumnWidths

Set myPict = .Pictures("Picture 3")
myPict.Copy
DestCell.Parent.Paste

With myPict
.Top = .Top
.Left = .Left
'myNewPict.Top = .Top
'myNewPict.Left = .Left
End With

Set DestCell = DestCell.Offset(10, 0)
Next myCell
End With

End Sub

 

[Dave Peterson]

I didn't realize that you wanted this in your loop.

But this won't do much. It just assigns the .top to the .top (no change at
all). And even worse, it's refering to the original picture.

With myPict
.Top = .Top
.Left = .Left
'myNewPict.Top = .Top
'myNewPict.Left = .Left
End With

Untested, but it did compile:

Option Explicit
Sub Generate()

Dim myCell As Range
Dim myRng As Range
Dim RngToCopy As Range
Dim DestCell As Range
Dim myPict As Picture
Dim myNewPict As Picture

Set DestCell = Worksheets.Add.Range("B2")

With Worksheets("r")
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With Worksheets("Z")

'this never changes, so don't do it in the loop
Set myPict = .Pictures("Picture 3")

For Each myCell In myRng.Cells

.Range("H3").Value = myCell.Value

Set RngToCopy = .Range("Branch")
RngToCopy.Copy

DestCell.PasteSpecial Paste:=xlPasteValues
DestCell.PasteSpecial Paste:=xlPasteFormats
DestCell.PasteSpecial Paste:=xlPasteColumnWidths

myPict.Copy
DestCell.Parent.Paste

'"grab" the newest picture that was pasted
With DestCell.Parent
Set myNewPict = .Pictures(.Pictures.Count)
End With

'on the first loop, m6 is 4 rows and 11 columns from B2
'should be the same relationship for the rest
With myNewPict
.Top = DestCell.Offset(4, 11).Top
.Left = DestCell.Offset(4, 11).Left
'give it a unique name
.Name = "Pict_" & DestCell.Offset(4, 11).Address(0, 0)
End With

'get ready for next time
Set DestCell = DestCell.Offset(10, 0)
Next myCell
End With

End Sub

 

[Max]

Marvellous, Dave. Thanks. That does it well.
Appreciate the patience & learnings, too.

 

[Dave Peterson]

Glad you got it working!

Marvellous, Dave. Thanks. That does it well.
Appreciate the patience & learnings, too.