I have a 2 column-datasheet with more than 1000 rows.

Example:

100: 6
190: 20020507217
200: Tsubakino, H.$Fukumoto, S.$Ono, #
204: Himeji
502: 3-88355-302-6
503: mw2001_529.pdf
561: 6S,6B,2T,6Q
565: Materials Week 2001, Internat. Congress on Adv
577: S.1-6

100: 6
130: EN
190: 20020507215
192: TIB-RR7407(2001)CD-R
200: Lutfullin, R.Y.$Kruglov, A.A.$Kaibyshev, O.A.
204: Russian Acad. of Sci. (RAS), RU
400: Superplastic forming of spherical vessels
502: 3-88355-302-6
503: mw2001_751.pdf
550: 2001
561: 6S,5B,1T,8Q
577: S.1-6
726: 3LF$3LNB$3KXM$3BA
740: Superplastizit„t, Beh„lterbau, Kugelform, F�gen, Umformen

Make sure that your only headers are in row 1.

This does Data|Filter|advanced filter to get a nice unique list from column
A--on a new sheet.

Then it transposes them into row 1.

Then it looks down each cell looking for a match -- and populates the cell.

You have to have a gap between each grouping.

Option Explicit
Sub testme01()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim myCell As Range
Dim res As Variant
Dim oRow As Long

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

curWks.Range("A:A").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=newWks.Range("A1"), Unique:=True

With newWks
With .Range("a:a")
.Sort key1:=.Columns(1), order1:=xlAscending, header:=xlYes

If Application.CountA(.Cells) .Parent.Columns.Count - 1 Then
MsgBox "too many columns when transposed"
Exit Sub
End If
End With

With .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
.Copy
.Parent.Range("b1").PasteSpecial Transpose:=True
.EntireColumn.Delete
End With
End With

oRow = 2
With curWks
For Each myCell In .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
If Trim(myCell.Value) = "" Then
oRow = oRow + 1
Else
res = Application.Match(myCell.Value, newWks.Rows(1), 0)
newWks.Cells(oRow, res).Value = myCell.Offset(0, 1).Value
End If
Next myCell
End With

End Sub


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

SerPetr wrote:

I have a 2 column-datasheet with more than 1000 rows.

Example:

100: 6
190: 20020507217
200: Tsubakino, H.$Fukumoto, S.$Ono, #
204: Himeji
502: 3-88355-302-6
503: mw2001_529.pdf
561: 6S,6B,2T,6Q
565: Materials Week 2001, Internat. Congress on Adv
577: S.1-6

100: 6
130: EN
190: 20020507215
192: TIB-RR7407(2001)CD-R
200: Lutfullin, R.Y.$Kruglov, A.A.$Kaibyshev, O.A.
204: Russian Acad. of Sci. (RAS), RU
400: Superplastic forming of spherical vessels
502: 3-88355-302-6
503: mw2001_751.pdf
550: 2001
561: 6S,5B,1T,8Q
577: S.1-6
726: 3LF$3LNB$3KXM$3BA
740: Superplastizit„t, Beh„lterbau, Kugelform, F�gen, Umformen

--

Dave Peterson