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
[TABLE="width: 211"]
<tbody>[TR]
[TD="colspan: 2"]a1
[/TD]
[TD="colspan: 2"]A15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD="colspan: 2"]A2
[/TD]
[TD="colspan: 2"]B15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD="colspan: 2"]a3
[/TD]
[TD="colspan: 2"]C15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD="colspan: 2"]a4
[/TD]
[TD="colspan: 2"]D15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD="colspan: 2"]a5
[/TD]
[TD="colspan: 2"]E15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD="colspan: 2"]a6
[/TD]
[TD="colspan: 2"]f15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD="colspan: 2"]a7
[/TD]
[TD="colspan: 2"]g15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD="colspan: 2"]a8
[/TD]
[TD="colspan: 2"]h15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD="colspan: 2"]a9
[/TD]
[TD="colspan: 2"]i15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD="colspan: 2"]a10
[/TD]
[TD="colspan: 2"]j15
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD="colspan: 2"]***
DATA
Macroout
A
[TABLE="width: 127"]
<tbody>[TR]
[TD][/TD]
[/TR]
[TR]
[TD]a1
[/TD]
[/TR]
[TR]
[TD]A15
[/TD]
[/TR]
[TR]
[TD]A2
[/TD]
[/TR]
[TR]
[TD]B15
[/TD]
[/TR]
[TR]
[TD]a3
[/TD]
[/TR]
[TR]
[TD]C15
[/TD]
[/TR]
[TR]
[TD]a4
[/TD]
[/TR]
[TR]
[TD]a1
[/TD]
[/TR]
[TR]
[TD]A15
[/TD]
[/TR]
[TR]
[TD]A2
[/TD]
[/TR]
[TR]
[TD]B15
[/TD]
[/TR]
[TR]
[TD]a3
[/TD]
[/TR]
[TR]
[TD]C15
[/TD]
[/TR]
[TR]
[TD]a4
[/TD]
[/TR]
[TR]
[TD]D15
[/TD]
[/TR]
[TR]
[TD]a5
[/TD]
[/TR]
[TR]
[TD]E15
[/TD]
[/TR]
[TR]
[TD]a6
[/TD]
[/TR]
[TR]
[TD]f15
[/TD]
[/TR]
[TR]
[TD]a7
[/TD]
[/TR]
[TR]
[TD]g15
[/TD]
[/TR]
[TR]
[TD]a8
[/TD]
[/TR]
[TR]
[TD]h15
[/TD]
[/TR]
[TR]
[TD]a9
[/TD]
[/TR]
[TR]
[TD]i15
[/TD]
[/TR]
[TR]
[TD]a10
[/TD]
[/TR]
[TR]
[TD]j15
[/TD]
[/TR]
</tbody>[/TABLE]


Code
[/TD]
[TD="colspan: 2"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
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.