question

any one can tell me please where is the Problem with my code ist working 3 times from 10 times where is the Problem the procces ist Import Excel file and delete the first and the second Rows after insert new row and edit the names in the row and after Input box but i think the Problem ist here DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "ps", imyDateiname, True all of the code Private Sub Command50_Click() DoCmd.SetWarnings False Const msoFileDialogFilePicker As Long = 1 Set fDialog = Application.FileDialog(msoFileDialogFilePicker) Dim selectedFilter As String Dim imyDateiname As String With fDialog .AllowMultiSelect = False .Filters.Clear .Filters.Add "Excel", "*.xlsx", 1 .Show If .SelectedItems.Count = 0 Then imyDateiname = "" Else imyDateiname = Dir(.SelectedItems(1)) End If selectedFilter = .FilterIndex End With If imyDateiname <> "" Then Dim oExc As New Excel.Application With oExc .Workbooks.Open "C:\Users\" & Environ("UserName") & "\Desktop\" & imyDateiname .Rows("1:2").Delete .Rows("1:2").EntireRow.Insert .Worksheets("ps").Columns("B").Replace _ What:="-", Replacement:=" ", _ SearchOrder:=xlByColumns, MatchCase:=True End With With oExc Cells(1, 1).Value2 = "Ebene" Cells(1, 2).Value2 = "OrgEinheit" Cells(1, 3).Value2 = "Titel" Cells(1, 4).Value2 = "PersNr" Cells(1, 5).Value2 = "Geburtsdatum" Cells(1, 6).Value2 = "Eintrittsdatum" Cells(1, 7).Value2 = "Befristungs" Cells(1, 8).Value2 = "Beginnalter" Cells(1, 9).Value2 = "Beginnfrei" Cells(1, 10).Value2 = "WK2" Cells(1, 11).Value2 = "WT" Cells(1, 12).Value2 = "Kostenstelle" Cells(1, 13).Value2 = "Schlüssel" Cells(1, 14).Value2 = "Tätigkeitsbezeichnung" Cells(1, 15).Value2 = "IRWAZ" Cells(1, 16).Value2 = "IstAK" Cells(1, 17).Value2 = "BelGrp" .ActiveWorkbook.SaveAs "C:\Users\" & Environ("UserName") & "\Desktop\" & imyDateiname .Quit End With DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "ps", imyDateiname, True Dim str As String str = InputBox("INSERT THE NUMBER OF THE MONTH PLEASE") execQry "upd_TPS_Monat", str Me.Refresh MsgBox "DONE YOUR DATA ARE READY!" End If End Sub