?
Solved

COPY SOME VALUES FROM A DIFFERENT SHEET AND PASTE WITH SPECIAL FORMAT

Posted on 2011-10-25
7
Medium Priority
?
192 Views
Last Modified: 2012-05-12
Hi,

Attached is a sample file where you could see the raw data as I have it in Sheet "DATA" and then in Sheet "STICKER" you can see the results that I'm looking for.

Basically I need for each row to copy all the values (from Sheet DATA) located in the following columns: B,C,D,I,J,M and paste it with the format you will see in Sheet STICKERS.

The last "Sticker" in the sample (Higlighted in light blue) contains the Column NAME from sheet DATA that is supposed to be placed there and the format need it.

I don't think that this is important, but please note that the Paper size of Sheet "STICKERS" is only 5,5 cms x 2,2 cms which is the stickers size We use here.

I really appreciatte your help and time,

Regards,
Roberto.
EE-STICKERS.xls
0
Comment
Question by:Pabilio
6 Comments
 
LVL 8

Expert Comment

by:ragnarok89
ID: 37027819
Use this:
Sub y()
Sheets("data").Select
temparray = Range("A2:M6")

Sheets("Hoja3").Select
Range("A1").Select
r = 0
For i = 1 To UBound(temparray)
    Range("A" & r + 1).Value = temparray(i, 4)
    Range("A" & r + 1 & ":B" & r + 1).Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .ShrinkToFit = True
    End With
    With Selection.Font
        .FontStyle = "Bold"
    End With
    
    Range("A" & r + 2).Value = temparray(i, 3)
    Range("A" & r + 2 & ":B" & r + 2).Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .ShrinkToFit = True
    End With
    
    Range("A" & r + 3).Value = temparray(i, 9)
    Range("A" & r + 3).HorizontalAlignment = xlLeft
    Range("B" & r + 3).Value = temparray(i, 10)
    
    Range("A" & r + 4).Value = temparray(i, 2)
    Range("A" & r + 4).HorizontalAlignment = xlLeft
    Range("B" & r + 4).Value = temparray(i, 13)
    Range("B" & r + 4).Font.Bold = True
    Range("B" & r + 4).HorizontalAlignment = xlRight
    
    r = r + 4
Next i

r = r + 1
Range("A" & r & ":B" & r).Select
Range("A" & r & ":B" & r).HorizontalAlignment = xlCenter
Selection.Merge
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "D"

Range("A" & r + 1 & ":B" & r + 1).Select
Range("A" & r + 1 & ":B" & r + 1).HorizontalAlignment = xlCenter
Selection.Merge
ActiveCell.FormulaR1C1 = "C"

Range("A" & r + 2).Value = "I"
    Range("A" & r + 2).HorizontalAlignment = xlLeft
    Range("B" & r + 2).Value = "J"
    Range("B" & r + 2).HorizontalAlignment = xlRight

Range("A" & r + 3).Value = "B"
    Range("A" & r + 3).HorizontalAlignment = xlLeft
    Range("B" & r + 3).Value = "M"
    Range("B" & r + 3).Font.Bold = True
    Range("B" & r + 3).HorizontalAlignment = xlRight
    
    Range("A" & r & ":B" & r + 3).Select
    With Selection.Interior
        .ColorIndex = 34
    End With
End Sub

Open in new window

0
 
LVL 24

Accepted Solution

by:
StephenJR earned 2000 total points
ID: 37027858
One way:
Sub x()

Dim r As Long, r2 As Long

With Sheets("DATA")
    For r = 2 To .Range("A" & Rows.Count).End(xlUp).Row
        r2 = r2 + 1
        Sheets("STICKERS").Cells(r2, 1).Value = .Cells(r, "D").Value
        Sheets("STICKERS").Cells(r2, 1).Font.Bold = True
        Sheets("STICKERS").Cells(r2, 1).Resize(, 2).HorizontalAlignment = xlCenterAcrossSelection
        Sheets("STICKERS").Cells(r2 + 1, 1).Value = .Cells(r, "C").Value
        Sheets("STICKERS").Cells(r2 + 1, 1).Resize(, 2).HorizontalAlignment = xlCenterAcrossSelection
        Sheets("STICKERS").Cells(r2 + 2, 1).Value = .Cells(r, "I").Value
        Sheets("STICKERS").Cells(r2 + 2, 2).Value = .Cells(r, "J").Value
        Sheets("STICKERS").Cells(r2 + 3, 1).Value = .Cells(r, "B").Value
        Sheets("STICKERS").Cells(r2 + 3, 2).Value = .Cells(r, "M").Value
        Sheets("STICKERS").Cells(r2 + 3, 2).Font.Bold = True
        r2 = r2 + 3
    Next r
End With
r2 = r2 + 1
With Sheets("STICKERS")
    .Cells(r2, 1).Value = "D"
    .Cells(r2, 1).Font.Bold = True
    .Cells(r2, 1).Resize(, 2).HorizontalAlignment = xlCenterAcrossSelection
    .Cells(r2 + 1, 1).Value = "C"
    .Cells(r2 + 1, 1).Resize(, 2).HorizontalAlignment = xlCenterAcrossSelection
    .Cells(r2 + 2, 1).Value = "I"
    .Cells(r2 + 2, 2).Value = "J"
    .Cells(r2 + 3, 1).Value = "B"
    .Cells(r2 + 3, 2).Value = "M"
    .Cells(r2 + 3, 2).Font.Bold = True
End With

End Sub

Open in new window

0
 
LVL 24

Expert Comment

by:StephenJR
ID: 37027860
Sorry, didn't refresh.
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 5

Author Comment

by:Pabilio
ID: 37028093
Hi Ragnaro,

Your code is giving me some problems with the select range
Line 3 and others...
I changed but still could not work with it.

Stephen your code works perfectly...!!

I'll wait for Ragnaro's fix (If he wants to) in order to close the question

Thank you both for your help.

Cheers,
Roberto.
0
 
LVL 50
ID: 37419403
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
 
LVL 5

Author Comment

by:Pabilio
ID: 37399072
Stephen,
I'm really sorry that I didnt close this question.
I tried now but It does not allow me to close it.
Please teylyn proceed as you said in your comment.
And have a happy new year both of you.
Best regards,
Roberto.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question