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

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
LVL 5
PabilioAsked:
Who is Participating?
 
StephenJRCommented:
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
 
ragnarok89Commented:
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
 
StephenJRCommented:
Sorry, didn't refresh.
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

 
PabilioAuthor Commented:
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
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
 
PabilioAuthor Commented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.