cell values mixed with text in output

[cccbzg]

Hi,

I'm trying to write code to take 2 columns of data on my input sheet and combine them on my Macroout sheet listing as col A1, col B1, col A2, col B2 etc. - this part works (see below). But what I'm trying to do is embed the cell values in some set text. For example:

Copy a1 to first line.
Then add a new line.
Copy A15 to the second line.
Then skip a line.
Copy A2 to first line.
Than add a new line.
Copy B15 ti the second line.
Then skip a line.

So the bold text would come from the cells and the rest of the text would be hard coded. The whole column of data should be in col C. Can't seem to get this...me and bright ideas. Uggg. Many, many thanks. Bonnie
DATA input sheet
A B

a1	A15
A2	B15
a3	C15
a4	D15
a5	E15
a6	f15
a7	g15
a8	h15
a9	i15
a10	j15
	*** DATA Macroout A a1 A15 A2 B15 a3 C15 a4 a1 A15 A2 B15 a3 C15 a4 D15 a5 E15 a6 f15 a7 g15 a8 h15 a9 i15 a10 j15 <tbody> </tbody> Code

<tbody>
</tbody>

Sub Macroyy()
Dim i As Long
Dim colA As String
Dim colB As String
Dim rngColA As Range
Dim bdata As String
Dim adata As String
Text = "TEXT"
With Sheet1
lFinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngColA = .Range(.Cells(1, "A"), .Cells(lFinalRow, "A"))
i = 1
colA = "A"
colB = "B"

For i = 1 To lFinalRow
Rows(i).Select

Sheets("input").Select

If UCase$(Trim$(Cells(i, colA).Value)) = "***" Then GoTo out

MsgBox "Found new cell" & Cells(i, colA)
'******************************
PROCESS:
Dim NextRow As Range

'****
Sheets("input").Range("a" & i).Copy
adata = Range("a" & i).Value
'Sheets("Macroout").Select
With Sheets("Macroout")
Set NextRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
NextRow.PasteSpecial Paste:=xlValues, Transpose:=True
End With
'*******
Sheets("input").Range("b" & i).Copy
bdata = Range("b" & i).Value
'Sheets("Macroout").Select
With Sheets("Macroout")
Set NextRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
NextRow.PasteSpecial Paste:=xlValues, Transpose:=True
End With
'****
Application.CutCopyMode = False
Set NextRow = Nothing

'***************************
Next i

End With
out:
End Sub

 

[AlphaFrog]

Give this a try if I followed your meaning.

[COLOR=darkblue]Sub[/COLOR] Macroyy2()
    [COLOR=darkblue]Dim[/COLOR] i       [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] NextRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    NextRow = Sheets("Macroout").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
    [COLOR=green]'Sheets("input").Select[/COLOR]
    
    [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] Sheets("input").Cells(Rows.Count, "A").End(xlUp).Row
    
        [COLOR=darkblue]If[/COLOR] UCase$(Trim$(Sheets("input").Cells(i, "A").Value)) = "***" [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
    
        [COLOR=green]'MsgBox "Found new cell " & Sheets("input").Cells(i, "A")[/COLOR]
    
        [COLOR=darkblue]With[/COLOR] Sheets("Macroout")
            .Cells(NextRow, "A").Value = "Copy " & Sheets("input").Cells(i, "A").Value & " to first line."
            NextRow = NextRow + 1
            .Cells(NextRow, "A").Value = "Then add a new line."
            NextRow = NextRow + 1
            .Cells([COLOR=darkblue]Next[/COLOR]Row, "A").Value = "Copy " & Sheets("input").Cells(i, "B").Value & " to second line."
            NextRow = NextRow + 2
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
        [COLOR=green]'***************************[/COLOR]
    Next i
    
    Sheets("Macroout").Select
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[cccbzg]

Wooo Hoooo! That worked great. Why couldn't I do that? Was part of my problem that I was trying to use offset? I see you just incremented NextRow.

THANKS SO MUCH!

 

[AlphaFrog]

You're welcome. Glad it works. Thanks for the feedback.