Solved: access to excel need help

[mercmannick]

hi

Enclosed is a book with all the relevant code ,

i have managed to modify code from a previous post , but just cant get VBA to put in the right place on sheet, if someone could show me where i am going wrong

Private Sub SetCells_EXTERNAL()
    Dim DataRow As Long, Cel As Range, Cols, c
    'Get next row to fill
    DataRow = Sheets("Data Access").Range("B2").End(xlUp).Row + 1

    'Fill data
    For Each Cel In Range([H2], [H2].End(xlDown))
        Select Case Cel
            Case "Speed"
                Cells(DataRow, "B") = Cel.Offset(, 1)
            Case "Cell E"
                Cells(DataRow, "C") = Cel.Offset(, 1)
            Case "Cell F"
                Cells(DataRow, "D") = Cel.Offset(, 1)
            Case "M74"
                Cells(DataRow, "E") = Cel.Offset(, 1)
            Case "Cell G"
                Cells(DataRow, "F") = Cel.Offset(, 1)
            Case "Cell W"
                Cells(DataRow, "G") = Cel.Offset(, 1)
            Case "S15"
                Cells(DataRow, "H") = Cel.Offset(, 1)
            Case "S70"
                Cells(DataRow, "I") = Cel.Offset(, 1)
            Case "S17"
                Cells(DataRow, "J") = Cel.Offset(, 1)
        End Select
    Next
    ' 'Check and fill blanks
    Cols = Array("B", "C", "D", "E", "F", "G", "H", "I", "J")
    For Each c In Cols
        If Cells(DataRow, c) = "" Then Cells(DataRow, c) = 0
    Next

End Sub

Many Thanks

Merc

[mercmannick]

sorry forgot to add Book

Sheets data access it is putting values in, i am trying to get it into Sheets"Data" in relevant place.

Merc

[mdmackillop]

[vba]Sub SetCells_EXTERNAL()
Dim TargCol As Long, Rw As Long, a As Range, Cel As Range
Application.ScreenUpdating = False
TargCol = Sheets("Data").[AC2].End(xlToLeft).Column + 1
With Sheets("Data")
For Each Cel In Range([K2], [K2].End(xlDown))
Set a = Cel.Range("B1:E1")
Rw = .Columns(1).Find(what:=Cel, lookat:=xlWhole).Row
a.Copy
.Cells(Rw, TargCol).PasteSpecial Paste:=xlPasteValues, _
Transpose:=True
Next
End With
Sheets("Data").Activate
'Check and fill blanks
Set a = Range(Cells(2, TargCol), Cells(37, TargCol))
For Each Cel In a
If Cel = "" Then Cel = 0
Next
With a.Font
.FontStyle = "Bold"
.ColorIndex = 3
End With
Cells(1, TargCol).Select
Application.ScreenUpdating = True
End Sub
[/vba]

[mercmannick]

mdmackillop

Fantastic thanks , works like a dream

Merc