(Måske) import af data

Ja - hvis du kan sende en kopi af filen /model.
@-adresse under min profil.

Indsat under arket MAIN
Const fraRDSkol = "C"
Const tilRDSkol = "Q"

Public vareNavn As String

Dim kol As String, cc, vnr1 As String
Private Sub Worksheet_Activate()
    vnr1 = ""
   
    With ComboBox1
        .Clear

Rem Indsæt VareNavne fra RDS
        For Each cc In Sheets("RDS").Range(fraRDSkol & "1" & ":" & tilRDSkol & "1").Cells
            vareNavn = cc.Text
            .AddItem vareNavn
           
            If vnr1 = "" Then
                vnr1 = cc
            End If
        Next cc
       
        .Text = vnr1
    End With
End Sub
Public Function hentFraRDSKol()
    hentFraRDSKol = fraRDSkol
End Function
Public Function hentTilRDSKol()
    hentTilRDSKol = tilRDSkol
End Function

Indsat under Module1
Const infoRækStart = 6
Dim ræk As Integer, vNavn As String
Dim cc, fra As String, til As String
Dim antalRæk As Integer
Sub Button7_Click()
    sletTidligereInfo

    vNavn = Sheets("main").ComboBox1
    fra = Sheets("MAIN").hentFraRDSKol
    til = Sheets("MAIN").hentTilRDSKol
   
    For Each cc In Sheets("RDS").Range(fra & "1" & ":" & til & "1").Cells
        If cc = vNavn Then
            søgKryds cc
            Exit Sub
        End If
    Next cc
   
    ingenData
End Sub
Private Sub søgKryds(cc)
Dim ræk As Integer, kol As Integer, infoRæk As Integer
    kol = cc.Column
    infoRæk = infoRækStart
   
    For ræk = 2 To 32000
        If Sheets("RDS").Range("B" & ræk) <> "" Then
            If Sheets("RDS").Cells(ræk, kol) = "x" Then
                Sheets("RDS").Range("B" & ræk).Copy
                Sheets("MAIN").Range("C" & infoRæk).Select
                Sheets("MAIN").Paste
                Application.CutCopyMode = False
               
                infoRæk = infoRæk + 1
            End If
        Else
            Exit For
        End If
    Next ræk
   
    If infoRæk = infoRækStart Then
        ingenData
    End If
End Sub
Private Sub ingenData()
    Sheets("MAIN").Range("C6") = "ingen data"
End Sub
Private Sub sletTidligereInfo()
Dim ræk As Integer
    For ræk = infoRækStart To 32000
        If Range("C" & ræk) <> "" Then
            Range("C" & ræk).ClearContents
        Else
            Exit Sub
        End If
    Next ræk
End Sub

Der er lagt et svar på version 1

Tak for hjælpen :D

Selv tak..