VBA Editor: Hente værdi fra tabel og overføre i nyt excel sheet.

Hejsa.

Jeg bruger selv følgende kode til at exportere en table til et nyt excel sheet, så du kan evt. bare nuppe det du skal bruge og tilpasse koden :o)

Private Sub ExportData2_Click()
On Error GoTo Err_ExportData2_Click

    Msg = "Do you want to export data to Excel?"
    Style = vbYesNo + vbExclamation + vbDefaultButton1
    Title = "Export Data"
    Response = MsgBox(Msg, Style, Title)
    If Response = vbNo Then GoTo Exit_ExportData2_Click

    strSQL = "SELECT * FROM [TABLE 1]"
    Set qdf = CurrentDb.CreateQueryDef("ExcelExport", strSQL)
    ExportToExcel CurrentDb.QueryDefs("ExcelExport").SQL
    DoCmd.DeleteObject acQuery, "ExcelExport"

Exit_ExportData2_Click:
    Exit Sub

Err_ExportData2_Click:
    MsgBox Err.Description
    Resume Exit_ExportData2_Click
   
End Sub

Public Function ExportToExcel(strSQL As String)
On Error GoTo Err_ExportToExcel

    Screen.MousePointer = 11

    Dim Exl As New Excel.Application
    Dim WrkBook As Excel.Workbook
    Dim rs As DAO.Recordset
    Dim i As Integer, j As Integer

    Set WrkBook = Exl.Workbooks.Add
    Set rs = CurrentDb.OpenRecordset(strSQL)

    If rs.EOF And rs.BOF Then GoTo Exit_ExportToExcel
    rs.MoveLast
    rs.MoveFirst
    For j = 1 To rs.Fields.Count - 1
        WrkBook.Sheets(1).Cells(1, j).Value = rs.Fields(j).Name
        strVAR = Len(rs.Fields(j).Name) + 2
        If strVAR < 6 Then
            strVAR = 6
        End If
        WrkBook.Sheets(1).Cells(1, j).ColumnWidth = strVAR
    Next j

    For i = 1 To rs.RecordCount
      For j = 1 To rs.Fields.Count - 1
        WrkBook.Sheets(1).Cells(i + 2, j).Value = rs.Fields(j)
      Next j
      rs.MoveNext
    Next i

    Exl.Visible = True

    rs.Close
    Set rs = Nothing
    Set WrkBook = Nothing
    Set Exl = Nothing

Exit_ExportToExcel:
    Screen.MousePointer = 0
    Exit Function

Err_ExportToExcel:
    MsgBox Err.Description
    Resume Exit_ExportToExcel

End Function

Tak for det :)