Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopieren ohne Shapes, Links, Formeln...

Kopieren ohne Shapes, Links, Formeln...
13.06.2019 09:33:03
Al
Hallo zusammen,
ich möchte mit dem folgenden Makro alle beschriebenen Zeilen des aktuellen Tabellenblattes "ONSHORE" ab der Zeile A2 übertragen in ein anderes Excelblatt "LIEFERVERZEICHNIS_test - Kopie.xlsm", dass im Verzeichnis "z:\test\allg\99_ABGABE\" liegt.
Das Kopieren funktionert schon, nur dass leider auch die Formatierungen, Shapes, Links, Formeln etc. übertragen werden. Dies soll aber nicht sein. Es soll lediglich der Textinhalt übertragen werden.
Ferner soll vor jeder eingefügten Zeile mit Textinhalten in der dazugehörigen Spalte A das Datum in Form "JJJJ-MM-TT" eingetragen werden.
Das Makro lautet wi folgt:
Sub Kopieren()
On Error GoTo Dateioffen 'Bei Fehlermeldung wird der Code bis zur entsprechenden  _
Sprungmarke übersprungen
Application.ScreenUpdating = False 'Aktualisierungen ausschalten (Flackern beim Ausführen  _
des Makros. einfach mal "auskommentieren" und testen wie es ohne ist Smile)
Dim leereZeile, wb As Workbook, ws As Worksheet, sh As Shape 'Variable definieren
'    'Kopieren der beschriebenen Zeilen ab A2 bis letzte
With Sheets("ONSHORE")
.Range("A2:Z" & .Cells(.Rows.Count, 2).End(xlUp).Row + 1).Copy
End With
'Datei öffnen
Workbooks.Open "z:\test\allg\99_ABGABE\LIEFERVERZEICHNIS_test - Kopie.xlsx"
'Aktiviert Tabellenblatt
Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Activate
'Erste leere Zeile in der Datei finden
leereZeile = Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Cells( _
Rows.Count, 1).End(xlUp).Row + 1
'Kopierte Daten in erste freie Zeile ab Spalte B einfügen
Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Range("B" &  _
leereZeile & ":AB" & leereZeile).Select
'einfügen ohne Shapes, Links, Formeln - also nur Textinhalte
ActiveSheet.Paste
'vor allen eingefügten Zeilen das Datum eintragen JJJJ-MM-TT
'Datei speichern und dann schließen
With Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx")
.Save
.Close
End With
Application.CutCopyMode = True 'Kopierspeicher leeren
Application.ScreenUpdating = True 'Aktualisierungen einschalten
MsgBox ("Daten sind erfolgreich übertragen worden") 'Nachricht dass alles ok ist
GoTo Überspringen
Dateioffen:     'Sprungmarke bei Fehlermeldung
MsgBox ("Kopiervorgang fehlgeschlagen! Zieldatei wird von einem anderem User bearbeitet." &  _
Chr(10) & Chr(10) & "Bitte später erneut versuchen.")
' Das Chr(10) bewirkt das der Text dahinter in einer 2ten zeile angezeigt wird
Überspringen:
End Sub
Hat jemand eine Idee? Ich wäre für jede Hilfe dankbar.
Grüße
Al

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren ohne Shapes, Links, Formeln...
13.06.2019 09:40:18
Nepumuk
Hallo,
benutze die PasteSpecial-Methode.
Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Range("B" &  _
leereZeile).PasteSpecial Paste:=xlPasteValues

Gruß
Nepumuk
AW: Kopieren ohne Shapes, Links, Formeln...
13.06.2019 09:48:05
Torsten
Hallo Al,
hab mal alles Activate und Select rausgeschmissen. Unnoetig.
Ausserdem Application.CutCopyMode muss auf False, um den Zwischenspeicher zu loeschen.
Hier dein Code, auch mit Datum eintragen:
Sub Kopieren()
On Error GoTo Dateioffen 'Bei Fehlermeldung wird der Code bis zur entsprechenden _
Sprungmarke übersprungen
Application.ScreenUpdating = False 'Aktualisierungen ausschalten (Flackern beim Ausführen _
des Makros. einfach mal "auskommentieren" und testen wie es ohne ist Smile)
Dim leereZeile As Long, neueletzteZeile As Long, wb As Workbook, ws As Worksheet, sh As  _
Shape 'Variable definieren
'    'Kopieren der beschriebenen Zeilen ab A2 bis letzte
With Sheets("ONSHORE")
.Range("A2:Z" & .Cells(.Rows.Count, 2).End(xlUp).Row + 1).Copy
End With
'Datei öffnen
Workbooks.Open "z:\test\allg\99_ABGABE\LIEFERVERZEICHNIS_test - Kopie.xlsx"
'Erste leere Zeile in der Datei finden
leereZeile = Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Cells( _
Rows.Count, 1).End(xlUp).Row + 1
'Aktiviert Tabellenblatt
With Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Range("B" &  _
leereZeile & ":AB" & leereZeile)
.PasteSpecial xlPasteValues
End With
'vor allen eingefügten Zeilen das Datum eintragen JJJJ-MM-TT
neueletzteZeile = Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten"). _
Cells(Rows.Count, 1).End(xlUp).Row
With Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Range("A" &  _
leereZeile & ":A" & neueletzteZeile)
.Value = Date
End With
'Datei speichern und dann schließen
With Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx")
.Save
.Close
End With
Application.CutCopyMode = False 'Kopierspeicher leeren
Application.ScreenUpdating = True 'Aktualisierungen einschalten
MsgBox ("Daten sind erfolgreich übertragen worden") 'Nachricht dass alles ok ist
GoTo Überspringen
Dateioffen:     'Sprungmarke bei Fehlermeldung
MsgBox ("Kopiervorgang fehlgeschlagen! Zieldatei wird von einem anderem User bearbeitet." &  _
_
Chr(10) & Chr(10) & "Bitte später erneut versuchen.")
' Das Chr(10) bewirkt das der Text dahinter in einer 2ten zeile angezeigt wird
Überspringen:
End Sub
Gruss Torsten
Anzeige
AW: Kopieren ohne Shapes, Links, Formeln...
13.06.2019 09:50:49
Torsten
sorry, diese Zeile bitte noch abaendern. Hier ist nur die Startzelle noetig:
With Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Range("B" &  _
leereZeile)
.PasteSpecial xlPasteValues
End With

AW: Kopieren ohne Shapes, Links, Formeln...
13.06.2019 11:07:23
Torsten
Und nochmal Hallo,
gerade sehe ich, dass ich einen kleinen Fehler gemacht habe beim Datum eintragen. Nicht davon zu sprechen, dass ich uebersehen habe, dass du das Datum in einem besonderen Format wolltest. Bitte diesen Teil ersetzen:

'vor allen eingefügten Zeilen das Datum eintragen JJJJ-MM-TT
neueletzteZeile = Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").  _
_
Cells(Rows.Count, 1).End(xlUp).Row
With Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Range("A" &  _
leereZeile & ":A" & neueletzteZeile)
.Value = Date
End With

mit

'vor allen eingefügten Zeilen das Datum eintragen JJJJ-MM-TT
neueletzteZeile = Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").  _
_
Cells(Rows.Count, 2).End(xlUp).Row
With Workbooks("LIEFERVERZEICHNIS_test - Kopie.xlsx").Sheets("Lieferdaten").Range("A" &  _
leereZeile & ":A" & neueletzteZeile)
.Value = Format(Date, "yyyy-mm-dd")
End With
Gruss
Anzeige
AW: Kopieren ohne Shapes, Links, Formeln...
13.06.2019 16:14:35
Al
Hallo Torsten,
klasse! Danke für die schnelle Hilfe. Ich habe deine Ergänzungen eingebaut.
Noch eine Frage zum Verständnis, da ich noch relativ neu bin in der VBA-Programmierung:
Bezüglich deiner Korrektur sehe ich (außer dem Format des Datums) nur, dass du das Cells(Rows.Count, 1) in Cells(Rows.Count, 2) geändert hat. Ich habe den Code mit Cells(Rows.Count, 1) getestet und der funktioniert auch. Kannst du mir den Unterschied erklären?
Danke dir.
Gruß
Al
AW: Kopieren ohne Shapes, Links, Formeln...
13.06.2019 11:47:23
Daniel
HI
hier mal eine Variante, etwas gekürzt und Optimiert:
Sub Kopieren()
Workbooks.Open ("z:\test\allg\99_ABGABE\LIEFERVERZEICHNIS_test - Kopie.xlsx")
If ActiveWorkbook.ReadOnly Then
MsgBox "die Zieldatei wird gerade von einem anderen User bearbeitet, versuchen sie es spä _
ter nochmal."
ActiveWorkbook.Close False
End If
ActiveWorkbook.Sheets("Lieferdaten").Select
With ThisWorkbook.Sheets("ONSHORE")
Intersect(.UsedRange, .UsedRange.Offset(1, 0)).Copy
End With
ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial  _
xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Selection.Columns(1).Offset(0, -1).Value = Date
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox "Daten erfolgreich übertragen"
End Sub
Beim Einfügen des Datums nutze ich hier aus, dass Excel die eingefügten Werte selektiert, so dass ich ausgehend von dieser Selektion die Zellen für das Datum ermitteln kann.
Bitte testen, ich habe es noch nicht getan.
Gruß Daniel
Anzeige
AW: Kopieren ohne Shapes, Links, Formeln...
13.06.2019 16:16:27
Al
Hallo Daniel,
danke dir für die schnelle Hilfe. Da es sich teilweise um große Listen handelt, teste ich mal die Schnelligkeit zwischen deinem und Torstens Code aus.
Grüße
AW: Kopieren ohne Shapes, Links, Formeln...
13.06.2019 16:26:48
Daniel
da solltest du keinen Unterschied merken.
die Codes machen eigentlich genau das gleiche.
Nur dass ich so zwischenwerte wie "Zeilennummer der letzten benutzen Zeile" nicht erst noch in einer Variablen speichere, weil ich den Wert nur 1x benötige bzw über andere Automatismen die Zellbereiche anspreche (UsedRange)
Daher wird mein Code etwas kompakter, was sich aber nicht auf die Geschwindigkeit auswirken sollte.
Gruß Daniel
Anzeige

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige