Kopieren und Einfügen in verschiedenen Mappen

Forumthread: 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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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.

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

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

Beliebteste Forumthreads (12 Monate)

Kopieren und Einfügen in verschiedenen Mappen

Forumthread: Kopieren und Einfügen in verschiedenen Mappen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Kopieren und Einfügen in verschiedenen Mappen

Forumthread: Kopieren und Einfügen in verschiedenen Mappen

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread