Overføre dataområde til SQL Server

Hvis det er muligt at overføre et helt dataområde i et hug, kan jeg jo kalde funktionen med navnet på arket/dataområdet, samt navnet på tabellen, som dataene skal sættes ind i...

Det tror jeg ikke man kan. jeg mener at det er nødt til at være record by record.
Hvis du vil lave koden flexibel, hvordan skal den så vide hvad feltet (det nye) hedder ?
Står det i headeren på excels liste eller.. ?

Well, regnearket dataområde, Data, består af 21 kolonner og 30 rækker.
Den første række i dataområdet indeholder overskrifter på kolonnerne.
Jeg tænkte nok det ikke bare var lige til... :(

Koden bliver også værre og værre:

r = 7 'Start i række 7, som er første datarække (række 6 er kolonneoverskrifter)
Do While r < 37 'Check at der kun læses fra de første 30 rækker
  Do While Worksheets("Ark2").Range("C" & r).Value = "" 'Hvis nøglefeltet er tomt, skal der navigeres til den næste række
    r = r + 1
    If r > 36 Then 'Hvis vi er nået forbi den sidste række, skal Sub'en stoppes
      Exit Sub
    End If
  Loop
    With rs
      .AddNew
      .Fields("Dato") = Worksheets("Ark1").Range("ProdDate").Value
      .Fields("Linie nr") = Worksheets("Ark2").Range("C" & r).Value
      .Fields("Art") = Worksheets("Ark2").Range("D" & r).Value
      .Fields("Str") = Worksheets("Ark2").Range("E" & r).Value
      .Fields("Type") = Worksheets("Ark2").Range("F" & r).Value
      .Update  End With
    r = r + 1
  Loop

Jeg ville meget gerne have reviewet koden, hvis det ikke kan lade sig gøre at overføre et helt dataområde på en gang, så jeg kan vise brugeren en "Alt ok!" besked, når Sub'en er kørt, hvilket ikke lader sig gøre pga. disse linier:
If r > 36 Then
  Exit Sub
End If

Hvordan skal det så se ud?

well, test det her

    Dim dataarea As Range
    Dim dataheaders As Variant
    'sæt dataarea = data
    Set dataarea = Sheets("Ark2").Range("data")
    'find headerne
    dataheaders = dataarea.Resize(1, dataarea.Columns.Count)
    'sæt dataarea = alt under headerne
    Set dataarea = dataarea.Offset(1, 0).Resize(dataarea.Rows.Count - 1, dataarea.Columns.Count)
    'for hver række i dataarea
    For Each r In dataarea.Rows
        'hvis nøglefeltet er udfyldt så...
        If dataarea(r, 1) <> "" Then

            With rs
                .AddNew
                .fields("Dato") = Worksheets("Ark1").Range("ProdDate").Value
                'for hver header indsæt værdien fra rækken
                For x = 1 To UBound(dataheaders, 2)
                    .fields(dataheaders(1, x)) = dataarea(r, x)
                Next
                .Update
            End With
        Else
            'ellers kom med en besked
            dataarea(r, 1).Select
            MsgBox "ikke udfyldt"
        End If
    Next

Hmmm....hvad skal r være dimensioneret som?
Har prøvet med Variant og Object, men det virker, koden går i stå her:

For Each r In dataarea.Rows

Sorry, jeg får en Type mismatch fejl i linien
If dataarea(r, 1) Is Null Then

når r er dimensioneret enten som en Variant eller Object.
:(

Har ændret lidt på koden og nu virker den.

    For r = 1 To dataarea.Rows.Count
        If dataarea(r, 1) <> 0 Then
            With rs
                .AddNew
                .Fields("Dato") = Worksheets(ark2).Range(range2).Value
                For x = 1 To UBound(dataheaders, 2)
                    .Fields(dataheaders(1, x)) = dataarea(r, x)
                Next
                .Update
            End With
        End If
    Next

Takker for hjælpen, læg et svar, så jeg kan tildele dig nogle point.

velbekomme