Follow along with the video below to see how to install our site as a web app on your home screen.
Anmerkung: This feature currently requires accessing the site using the built-in Safari browser.
Sub PruefeNummer()
Dim zeilen As Long
Dim a As Long
'letzte Zeile (in Spalte A) der Tabelle 2 ermitteln
zeilen = Tabelle2.Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To zeilen
'Vergleich eins prüft die Länge, Vergleich zwei wandelt den enthaltenen Text zuerst in
'eine Zahl um (dadurch gehen eventuell vorhandene ungültige Zeichen "verloren") und verlgeicht das
'dann mit dem Inhalt der Zelle.
If Len(Tabelle2.Cells(a, 1)) <> 6 Or Val(Tabelle2.Cells(a, 1)) <> Tabelle2.Cells(a, 1) Then
Tabelle2.Cells(a, 1).Activate
MsgBox "Die Angaben in Zeile " & a & " sind ungültig!", vbOKOnly, "Fehler"
Exit Sub
End If
Next a
End Sub
Private Sub CommandButton1_Click()
'ggf. Laufwerk und Ordner als Vorgabe setzen
ChDir "\"
ChDrive "c:\"
'Das Dialogfenster
Dateiname = Application.GetOpenFilename _
("Micrsoft Excel-Dateien (*.xlsx),*.xlsx") 'halt notfalls nur xls
If Dateiname = False Then Exit Sub
'MsgBox "Ihre Auswahl:" & vbNewLine & Dateiname
' tabelle 2 inhalt löschen noch machen
' öffnet datei
Workbooks.Open Filename:=Dateiname, UpdateLinks:=0, ReadOnly:=True
' daten rauskopieren
'Windows(Dateiname).Activate
Sheets("Vorlage").Activate 'wenn anders heißt, anpassen
Range(Cells(1, 1), Cells(22000, 23)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'selektiert bereich
Range("A1:R" & Cells(65000, 1).End(xlUp).Row).Select
Range("A2:Q21438").Select
Selection.Copy
Windows("Mappe.xlsm").Activate
Sheets("Tabelle2").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub