Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1564to1568
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

Kopieren und Einfügen in verschiedenen Mappen

Kopieren und Einfügen in verschiedenen Mappen
30.06.2017 22:08:22
Andreas
Guten Abend,
Nun bin ich mit meinen bescheidenen Makro-Programmiergrenzen am Ende angekommen.
Folgendes wollte ich mit einem Makro erledigen.
Ich beschreib mal die gewollten Abläufe:
* Worksheets("Druckmenü") ist geöffnet.
* Zellinhalt von O28 nach drücken von Enter kopieren und eine noch geschlossene
andere Mappe öffnen evtl.so
Workbooks.Open Filename:="D:\Vorlagen\ProtokollnR.xlsx"
* dort dann in Spalte B die letzte ausgefüllte Zelle finden und den Zellinhalt eine Zelle tiefer einfügen. evtl. so?
Application.GoTo Range("B65536").End(xlUp).Offset(1, 0)
* dann in dieser Zeile eine Spalte zurück springen,- also Offset(1, -1)
hier befindet sich jedoch eine Formel- es soll aber deren Ergebnis kopiert werden und das dann in Worksheets("Druckmenü")in Y35 eingefügt werden.
evtl so?
Worksheets("Vorlage.xlsx").Worksheets("Drückmenü").Range("y35").PasteSpecial xlPasteValues
aber so richtig will das auch nicht.
Nun hoffentlich sieht hier noch jemand durch.
Kann jemand beim Code helfen?
MfG Andreas

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren und Einfügen in verschiedenen Mappen
01.07.2017 07:14:29
Hajo_Zi
hallo Andreas,
Du hast die Aufgabe nicht ganz beschrieben, da Du die Lösung selber an Deine Bedingungen anpassen wollest. Viel Erfolg.
Option Explicit
Sub Uebertragen()
' Datei öffnen
With Worksheets("Tabelle2")
Dim LoLetzte As Long
LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, . _
Rows.Count) + 1
ThisWorkbook.Worksheets("Druckmenü").Copy .Cells(LoLetzte, 2)
.Cells(LoLetzte - 1, 1).Copy
ThisWorkbook.Worksheets("Druckmenü").Range("Y35").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False         'Zwischenspeicher löschen
End With
ActiveWorkbook.Close True
End Sub


Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben, mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
Anzeige
AW: Kopieren und Einfügen in verschiedenen Mappen
01.07.2017 11:00:02
Andreas
Danke Hajo-
nun es geht doch noch nicht wie ich will.
Habe nun mal meine Version - die mit dem Makrorecorder hier abgebildet,
Vielleicht nochmal das Vohaben-
* Worksheets("Druckmenü") ist geöffnet.
* Doppelklick in O28 '(öffnet Mappe Druckmenü Tabelle1)
** jetzt trage ich einen Text in O28 ein- drücke ENTER und es soll der
* Zellinhalt von O28 kopiert und die andere Mappe (Druckmenü Tabelle1 - letzte ausgefüllte Zelle in B finden- eine Zeile tiefer springen dort den Text einfügen.
als nächster Schritt
*in dieser Zeile eine Spalte nach links springen (es ist die Spalte A- dort steht jetzt eine Nr. hier befindet sich aber auch eine Formel- es soll aber nur deren Ergebnis kopiert werden und das dann in Worksheets"Druckmenü"in Y35 eingefügt werden.
Worksheets("Druckmenü").Range("y35").PasteSpecial xlPasteValues
* nun Mappe ("ProtokollnR 1.xlsx") schließen und zurück zu Worksheets("Druckmenü")
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address(0, 0) = "O28" Then
Workbooks.Open Filename:="D:\ProtokollnR 1.xlsx"
Cancel = True
End If
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("Vorlage.xlsm").Activate
Range("O28").Select
'Windows("Vorlage.xlsm").Activate
Selection.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
Application.WindowState = xlNormal
Windows("ProtokollnR 1.xlsx").Activate
Application.GoTo Range("B65536").End(xlUp).Offset(1, 0)
Selection.Copy
'Worksheets("Vorlage.xlsm").Worksheets("Druckmenü").Range("y35").PasteSpecial xlPasteValues
Worksheets("Druckmenü").Range("y35").PasteSpecial xlPasteValues
Windows("Vorlage.xlsm").Activate
Selection.Copy
Windows("ProtokollnR 1.xlsx").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.GoTo Range("B65536").End(xlUp).Offset(1, -1)
Selection.Copy
'Worksheets("Vorlage.xlsm").Worksheets("Druckmenü").Range("y35").PasteSpecial xlPasteValues
'Range("A197").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Vorlage.xlsm").Activate
Windows("ProtokollnR 1.xlsx").Activate
'Range("A196").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Vorlage.xlsm").Activate
Range("Y35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

So den richtigen Durchblick habe ich hier nicht.
Vielleicht geht das auch so nicht.
Gruß Andreas
Anzeige
Makro funktioniert nur beim ersten erstellen
01.07.2017 17:27:49
Andreas
Nun habe ich das Makro bereits zum fünften mal neu erstellt.
Es funktioniert immer nur nach der Erstellung. Speichere und schließe ich die Mappen , öffne sie erneut und starte das gleiche Makro - werden keine Daten Kopiert und eingefügt.
Es kommt aber auch keine Fehlermeldung.
Was könnte da sein? (--- ich speichere vor dem Schließen---)
Option Explicit
Sub Auto_Nr_Vergabe()
Workbooks.Open Filename:="D:\ProtokollnR 1.xlsx"
' Nr und Ort automatisch in Protokollliste
Windows("ProtokollnR 1.xlsx").Activate
Application.CutCopyMode = False         'Zwischenspeicher löschen
Range("O28").Select
Application.CutCopyMode = False
Selection.Copy
Windows("ProtokollnR 1.xlsx").Activate
Application.GoTo Range("B65536").End(xlUp).Offset(1, 0)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.GoTo Range("B65536").End(xlUp).Offset(0, -1)
Application.CutCopyMode = False
Selection.Copy
Windows("Vorlage ortsveraenderliche .xlsm").Activate
Range("Y35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("W35:Z35").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Windows("ProtokollnR 1.xlsx").Activate
Application.GoTo Range("B65536").End(xlUp).Offset(1, -1)
Application.CutCopyMode = False         'Zwischenspeicher löschen
End Sub

Anzeige

345 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige