Anzeige
Archiv - Navigation
1816to1820
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Nur Text übertragen

Nur Text übertragen
07.03.2021 10:53:41
Ulrich
Hallo Zusammen,
ich habe eine Frage.
Mit folgenden Code übertrage ich Daten von einem Tabellenblatt(Meldebogen) in die nächste Zeile eines anderen Tabellenblatt (Übersicht)
Jetzt hätte ich gerne
1. nur den Text übernommen
2. in der neuen geschriebenen Zeile in den Zellen von Spalte A-O einen einfachen Rahmen.
3. in Zeile A eine fortlaufende Nummer eingegeben
Ich hatte folgenden Code für die laufende Nummer, aber das klappt irgendwie nicht
(Cells(7, 1).Value = 1
Range(Cells(7, 1), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 1)).DataSeries
End Sub )
Kann mir jemand dabei helfen? Danke für die Hilfe
Gruß Ulli
Public Sub Übertragen()
' Übertragen Makro
Dim loLetzte As Long
'Dim lngEND As Long, lngRow As Long
Dim Zeile As Long, Spalte As Long ', Spaltenzähler As Long
With Sheets("Übersicht")
loLetzte = .Range("D:D").Cells.Find("*", searchdirection:=xlPrevious).Row + 1
End With
With Sheets("Meldebogen")
Sheets("Übersicht").Cells(loLetzte, 1) = .Range("I4")
.Range("Datum").Copy Sheets("Übersicht").Cells(loLetzte, 2)
.Range("Nachname").Copy Sheets("Übersicht").Cells(loLetzte, 4)
.Range("Vorname").Copy Sheets("Übersicht").Cells(loLetzte, 5)
End With
End Sub


18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nur Text übertragen
07.03.2021 10:56:04
Hajo_Zi
Hallo Uli,
in der Art
Range("A19").Copy
Range("A20").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


AW: Nur Text übertragen
07.03.2021 11:12:24
Ulrich
Hallo Hajo,
aber wie bekomme ich das hier integriert?
.Range("Nachname").Copy Sheets("Übersicht").Cells(loLetzte, 4)
Ich übertrage 12 Zellen, muss ich das dann hinter jeder Anweisung schreiben?
Gruß Ulli

AW: Nur Text übertragen
07.03.2021 11:29:23
Hajo_Zi
ersetze Range("A19") durch .Range("Nachname")
und
Range("A20") durch sheets("Übersicht").Cells(loLetzte, 4)
Du schreibstz schon VBA, da war ich davon ausgegangen das Dir das klar ist.
Gruß Hajo

Anzeige
AW: Nur Text übertragen
07.03.2021 11:43:52
Ulrich
Hallo Hajo,
danke, ja das funktioniert.
Die Daten werden ja in eine neu erstellet Zeile übertragen.
Wie bekomme ich es hin das ich in dieser neuen Zeile von Spalte A-O einen einfachen Rahmen erzeuge, auch wenn ein Feld leer sein sollte.
Gruß Ulli

AW: Nur Text übertragen
07.03.2021 13:07:01
Hajo_Zi
Hallo Uli,
benutze den Makrorecorder.
Gruß Hajo

AW: Nur Text übertragen
07.03.2021 11:39:10
volti
Hallo Ulrich,
hier noch eine Idee zu Deinem Anliegen...
Code:

[Cc]

Public Sub Übertragen() ' Übertragen Makro Dim loLetzte As Long, WShQ As Worksheet Set WShQ = Sheets("Meldebogen") With Sheets("Übersicht") loLetzte = .Range("D:D").Cells.Find("*", SearchDirection:=xlPrevious).Row + 1 .Cells(loLetzte, 1).Value = Val((.Cells(loLetzte - 1, 1).Value)) + 1 .Cells(loLetzte, 2).Value = WShQ.Range("Datum").Value .Cells(loLetzte, 4).Value = WShQ.Range("Nachname").Value .Cells(loLetzte, 5).Value = WShQ.Range("Vorname").Value ' Rahmen With .Range(Replace("A1:E1", "1", loLetzte)).Borders .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin 'xlHairline End With End With End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz


Anzeige
AW: Nur Text übertragen
07.03.2021 12:26:32
Ulrich
Hallo Karl-Heinz,
das funktioniert super!! Danke
Jetzt habe ich noch eine Frage.
In der Übersichtliste in Spalte 3 wird der Dateiname der Protokolldatei eingetragen, dieser setzt sich aus 3 Zellen zusammen.
Die Protokolldatei mit entsprechendem Namen wird in einen Unterordner "Makro" gespeichert
Ist es möglich dahin eine Verknüpfung (Link) auf den Eintrag in Spalte 3 zu erzeugen?
Der Ablauf ist wie folgt:
1. Eintragen von Daten in das Arbeitsblatt "Meldebogen".
dann Aufruf des Makro "Speichern" mit folgenden Schritte:
1. Übertrag von gewissen Daten in das Arbeitsblatt "Übersichtliste" (mit deinem Makro)
2. Speichern des Meldebogens unter einem zusammengesetzten Namen aus 3 Zellen in dem Unterordner (Makro)
3. Löschen der eingegebenen Daten.
Die ganzen Schritte funktionieren schon, es fehlt der Link zur Datei
Hast du vielleicht eine Idee für den Link zur Datei?
Gruß Ulli

Anzeige
AW: Nur Text übertragen
07.03.2021 13:19:38
Ulrich
Hallo Karl Heinz,
Ich muss wahrscheinlich die Übersichtsliste als eigene Datei machen, befindet sich in dem gleichen Ordner.
Wie müsste ich jetzt deinen Vorschlag ändern?
Danke für deine Hilfe.
Gruß Ulli

AW: Nur Text übertragen
07.03.2021 17:59:14
volti
Hallo Ulli,
hier ein mögliches (ungetestetes) Update.
Die Übersichtsdatei (noch umbenennen) muss schon offen sein, ansonsten muss das Öffnen noch nachprogrammiert werden.
Code:

[Cc][+][-]

Public Sub Übertragen() ' Übertragen Makro Dim loLetzte As Long, WShQ As Worksheet Dim sPath As String, sFileName As String Set WShQ = Sheets("Meldebogen") sPath = ThisWorkbook.Path & "\Makro\" sFileName = "Test.xlsm" ' Dein bereits aus 3 Felder ermittelter Dateiname ' Unterstellt, dass die Datei bereits geöffnet ist With Workbooks("Übersicht.xlsm").Sheets("Übersicht") loLetzte = .Range("D:D").Cells.Find("*", SearchDirection:=xlPrevious).Row + 1 .Cells(loLetzte, 1).Value = Val((.Cells(loLetzte - 1, 1).Value)) + 1 .Cells(loLetzte, 2).Value = WShQ.Range("Datum").Value .Hyperlinks.Add Anchor:=.Cells(loLetzte, 3), _ Address:=sPath & sFileName, _ TextToDisplay:=sFileName .Cells(loLetzte, 4).Value = WShQ.Range("Nachname").Value .Cells(loLetzte, 5).Value = WShQ.Range("Vorname").Value ' Rahmen With .Range(Replace("A1:E1", "1", loLetzte)).Borders .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin 'xlHairline End With End With End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz


Anzeige
AW: Nur Text übertragen
07.03.2021 18:29:22
Ulrich
Hallo Karl Heinz,
vielen Dank für deine Mühe!
es ist nur so das mit jedem Meldebogen eine neue Datei und entsprechend ein neuer Dateiname erzeugt wird.
Deshalb kann ich hier nichts eintragen.
sFileName = "Test.xlsm" ' Dein bereits aus 3 Felder ermittelter Dateiname
sFileName ist praktisch immer der Wert in der Zelle in Spalte 3
Die Übersichtdatei sieht dann so aus.
Und in der Spalte 3 sollte dann der Link zur entsprechenden Datei (Name wie Text in dieser Zelle)
ich hatte auch mal so etwas gefunden, vielleicht ist das auch irgendwie verwendbar
(=HYPERLINK("C:\"&A1&".xlsm";A1))
Gruß Ulli
Userbild

Anzeige
AW: Nur Text übertragen
07.03.2021 18:59:53
volti
Hallo Ulli,
da kann ich Dir leider nicht ganz folgen:
In Zelle .Cells(loLetzte, 3).Value steht bei der Abarbeitung kein Dateiname. Es ist ja eine neue Zeile, die noch nicht gefüllt ist.
Bei Abarbeitung kommt dann der Hyperlink rein, hierfür wird der Dateiname benötigt, der aktuell noch nicht bekannt ist.
Oder soll der Dateiname aus den anderen Feldern gebildet werden?
Code:

[Cc][+][-]

Public Sub Übertragen() ' Übertragen Makro Dim loLetzte As Long, WShQ As Worksheet Dim sPath As String Set WShQ = Sheets("Meldebogen") sPath = ThisWorkbook.Path & "\Makro\" ' Unterstellt, dass die Datei bereits geöffnet ist With Workbooks("Übersicht.xlsm").Sheets("Übersicht") loLetzte = .Range("D:D").Cells.Find("*", SearchDirection:=xlPrevious).Row + 1 .Cells(loLetzte, 1).Value = Val((.Cells(loLetzte - 1, 1).Value)) + 1 .Cells(loLetzte, 2).Value = WShQ.Range("Datum").Value .Cells(loLetzte, 4).Value = WShQ.Range("Nachname").Value .Cells(loLetzte, 5).Value = WShQ.Range("Vorname").Value .Cells(loLetzte, 3).Value = "UA_" _ & .Cells(loLetzte, 4).Value & "_" _ & .Cells(loLetzte, 5).Value & "_" _ & Format$(.Cells(loLetzte, 2).Value, "yyyymmdd") .Hyperlinks.Add Anchor:=.Cells(loLetzte, 3), _ Address:=sPath & .Cells(loLetzte, 3).Value & ".xlsm", _ TextToDisplay:=.Cells(loLetzte, 3).Value ' Rahmen With .Range(Replace("A1:E1", "1", loLetzte)).Borders .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin 'xlHairline End With End With End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz


Anzeige
AW: Nur Text übertragen
07.03.2021 19:17:37
Ulrich
Hallo Karl-Heinz,
in Spalte Drei der Übersichtsdatei wird der Wert von der Zelle ("Dateiname")aus der Protokolldatei übergeben, dies ist auch gleichzeitig der Dateiname & xlsm der dann gespeicherten Protokolldatei.
Ich habe auch noch etwas versucht.
es wird schon ein link hinterlegt, aber die Datei wird noch nicht gefunden.
Gruß Ulli
Public Sub Übertragen()
' Übertragen Makro
Dim loLetzte As Long, WShQ As Worksheet
Dim strZiel As String, wkbZiel As Workbook, WShZ As Worksheet, sFileName As String
Dim sPath As String
sPath = ThisWorkbook.Path & "\Makro\"
sFileName = WShQ.Range("Dateiname" & xlsm)
Set WShQ = ActiveWorkbook.Sheets("Meldebogen")
'Prüfen, Zieldatei shon geöffnet
strZiel = "Übersicht.xlsm"  'Name Zieldatei ggf. anpassen
For Each wkbZiel In Application.Workbooks
If LCase(strZiel) = LCase(wkbZiel.Name) Then Exit For
Next
If wkbZiel Is Nothing Then
Set wkbZiel = Application.Workbooks.Open(ThisWorkbook.Path & "\" & strZiel)
End If
Set WShZ = wkbZiel.Worksheets("Übersicht")
With WShZ
loLetzte = .Range("D:D").Cells.Find("*", SearchDirection:=xlPrevious).Row + 1
.Cells(loLetzte, 1).Value = Val((.Cells(loLetzte - 1, 1).Value)) + 1
.Cells(loLetzte, 2).Value = WShQ.Range("Datum").Value
.Cells(loLetzte, 3).Value = WShQ.Range("Dateiname").Value
.Hyperlinks.Add Anchor:=.Cells(loLetzte, 3), _
Address:=sPath & sFileName, _
TextToDisplay:=WShQ.Range("Dateiname" & xlsm).Value
.Cells(loLetzte, 4).Value = WShQ.Range("Nachname").Value
.Cells(loLetzte, 5).Value = WShQ.Range("Vorname").Value
' Rahmen
With .Range(Replace("A1:O1", "1", loLetzte)).Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin  'xlHairline
End With
End With
'strZiel.Close SaveChanges:=True
End Sub


Anzeige
AW: Nur Text übertragen
07.03.2021 19:45:20
volti
Hallo Ulli,
also diese wichtige Information fehlte aber in Deiner ersten Anforderung....
Wenn es jetzt so gemacht wird, ist das mit dem sFilename entbehrlich bzw. sogar falsch.
So sollte es dann jetzt funktionieren:
Code:

[Cc][+][-]

Public Sub Übertragen() ' Übertragen Makro Dim loLetzte As Long, WShQ As Worksheet Dim sPath As String Set WShQ = Sheets("Meldebogen") sPath = ThisWorkbook.Path & "\Makro\" ' Unterstellt, dass die Datei bereits geöffnet ist With Workbooks("Übersicht.xlsm").Sheets("Übersicht") loLetzte = .Range("D:D").Cells.Find("*", SearchDirection:=xlPrevious).Row + 1 .Cells(loLetzte, 1).Value = Val((.Cells(loLetzte - 1, 1).Value)) + 1 .Cells(loLetzte, 2).Value = WShQ.Range("Datum").Value .Cells(loLetzte, 4).Value = WShQ.Range("Nachname").Value .Cells(loLetzte, 5).Value = WShQ.Range("Vorname").Value .Cells(loLetzte, 3).Value = WShQ.Range("Dateiname").Value .Hyperlinks.Add Anchor:=.Cells(loLetzte, 3), _ Address:=sPath & .Cells(loLetzte, 3).Value & ".xlsm", _ TextToDisplay:=.Cells(loLetzte, 3).Value & ".xlsm" ' Rahmen With .Range(Replace("A1:E1", "1", loLetzte)).Borders .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin 'xlHairline End With End With End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz


Anzeige
AW: Nur Text übertragen
07.03.2021 21:28:26
Ulrich
Hallo Karl Heinz,
ich habe es jetzt so geändert, funktioniert einwandfrei!! super
Ganz herzlichen Dank.
Noch eine spontane Frage.
Wenn ich jetzt über den Link die Meldedatei öffne und etwas ändern würde; ist dann eine Verknüpfung zur Übersichtdatei möglich?
So das die Änderung (nur die entsprechenden Felder die übertragen werden) dann auch in der Übersichtsdatei geändert würden?
Ich denke sehr schwierig da keine Verknüpfung existiert.
Ich wünsche dir einen guten Start in die Woche.
Viele Grüße Ulli

AW: Nur Text übertragen
07.03.2021 21:42:17
Ulrich
Hallo Karl-Heinz,
beim Speichern meiner Meldedatei (mit aufrufen des Makros "Übertrag") kommt jetzt noch folgender Fehler.
Hast du eine Idee.
Gruß Ulli
Userbild

Anzeige
AW: Nur Text übertragen
07.03.2021 23:04:55
volti
Hallo Ulli,
durch das Übertragen-Makro wird keine Einstellung verändert.
Und ohne Fehlermeldung und Prüfmöglichkeit habe ich auch nur folgenden Tipp:
Stelle sicher, dass im Feld "Dateiname" ein gültiger Dateiname steht und das Meldebogenblatt aktiv ist.
Denn Range("Dateiname").value greift ja auf das aktive Blatt zu.
Gruß KH

AW: Nur Text übertragen
08.03.2021 15:55:16
Ulrich
Hallo Karl Heinz,
vielen Dank für deine Hilfe.
Nach dem ich heute morgen den Rechner neu gestartet habe war der Fehler weg.
Danke noch einmal für deine Unterstützung.
Gruß Ulli

AW: Nur Text übertragen
07.03.2021 19:24:55
Ulrich
Oben so
sFileName = ("Dateiname" & xlsm)
und nicht so
sFileName = WShQ.Range("Dateiname" & xlsm)
geht aber trotzdem noch nicht
Gruß Ulli

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige