Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1584to1588
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ganzer Inhalt Selection von Wb zu anderem Wb

Ganzer Inhalt Selection von Wb zu anderem Wb
20.10.2017 18:21:49
Wb
Guten Abend
Ich habe zwei Dateien offen, die von der Sturktur her gleich sind.
Nun möchte ich aus der aktiven Datei ein Makro aufrufen, das bewirkt, dass der selektierte Range (Selection) aus der aktiven Datei in die zweite Datei genau am selben Ort (Worksheet, Range) eingetragen wird.
Warum funktioniert mein Code nicht (aktuell in der letzten Zeile vor End Sub )?
Sub Auswahl_in_andere_Datei()
Dim ThisWb as Workbook, OtherWB as Workbook
Dim ThisSh as Worksheet, OtherSh as Worksheet
Dim strASh1 as String, strWB as String
Set ThisWb = ActiveWorkbook
strWB = Sheets("oD").Range("A2") ''Hier ist der Dateiname hinterlegt
strASh1 = ActiveWorkbook.ActiveSheet.Name
Set OtherWB = Workbooks(strWB)
Set ThisSh = ThisWb.Sheets(strASh1)
Set OtherSh = OtherWB.Sheets(strASh1)
Set rngQuelle = ThisShSelection
Set rngZiel = OtherSh.Range(rngQuelle.Address)
ThisSh.rngQuelle.Copy OtherSh.rngZiel
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Ganzer Inhalt Selection von Wb zu anderem Wb
20.10.2017 18:53:59
Wb
Hallo Peter,
wenn ich die Vba-Hilfe zu 'Range.Copy-Methode (Excel)' richtig verstanden habe, so soll man
nur die 1. Zelle als Zielpunkt der Kopieraktion angeben, also:
Set rngZiel = OtherSh.Range(rngQuelle.Address).Cells(1,1)
ThisSh.rngQuelle.Copy OtherSh.rngZiel
oder
Set rngZiel = OtherSh.Range(rngQuelle.Address)
ThisSh.rngQuelle.Copy OtherSh.rngZiel.Cells(1,1)
siehe: https://msdn.microsoft.com/de-de/VBA/Excel-VBA/articles/range-copy-method-excel
Gruß von Luschi
aus klein-Paris
AW: Ganzer Inhalt Selection von Wb zu anderem Wb
21.10.2017 08:29:34
Wb
Hallo Luschi
Vielen Dank für den Hinweis.
Gruss, Peter
AW: Ganzer Inhalt Selection von Wb zu anderem Wb
21.10.2017 05:41:19
Wb

Option Explicit
Public Sub IchMöchte()
' Und ICH deklariere Public Sub, damit sie unabhängig von der Arbeitsmappe
'> den jeweils selektierten Bereich in die andere (geöffnete Arbeitsmappe) kopiert
Dim oWb As Excel.Workbook, wb As Excel.Workbook
Dim oSh As Excel.Worksheet
Dim rngS As Range, rngT As Range
On Error GoTo errh
'Vorausetzung: nur 2 geöffnete Arbeitsmappen in der Applikation
If Workbooks.Count  2 Then Err.Raise 513
'Vorausetzung: der selektierte Range (Selection) ist ja immer
'der Bereich wenn das Makro gestartet wird
Set rngS = Selection
Set oSh = rngS.Parent
For Each wb In Workbooks
If wb.Name  oSh.Parent.Name Then Set oWb = wb
Next wb
'jetzt kann der Affe ins Wasser hüpfen
Set rngT = oWb.Sheets(rngS.Parent.Name).Range(rngS.Cells(1).Address)
rngS.Copy rngT
On Error GoTo 0
errh:
Select Case Err.Number
Case 0
'fehlerfrei
Case 513
Call MsgBox("keine 2 Arbeitsmappen", vbExclamation, "Abbruch")
Case Else
'ICH habe geschlampt
End Select
End Sub

Anzeige
AW: Ganzer Inhalt Selection von Wb zu anderem Wb
21.10.2017 08:43:12
Wb
Hallo
Vielen Dank für diesen Code.
Ich habe alles etwas komplizierter angestellt. Allerdings bleiben so noch zwei Probleme:
- ich habe (ausgeblendet) auch noch die Datei "PERSONAL.XLSB" geöffnet - kann man die Abfrage, wie viele Dateien offen sind nur auf die eingeblendeten Dateien beschränken? (Hätte den Vorteil, dass ich gegebenenfalls noch eine andere offene Datei temporär ausblenden kann).
- Ab und zu sind in der Selection auch benannte Bereiche vorhanden. Diese sind in der Zielarbeitsmappe auch vorhanden - deshalb kann der Name in der Zieldatei analog verwendet werden. - Jetzt kommt noch die Meldung "Der Name '_abc' ist bereits vorhanden. Klicken Sie auf 'Ja', um diese Version des Namens zu verwenden, oder klicken Sie auf 'Nein', um die Version von 'abc', die Sie verschieben oder kopieren möchten, umzubenennen." --> Die Antwort soll also standardmässig "Ja" sein.
Wie kann das gelöst werden?
Gruss, Peter
Anzeige
AW: Ganzer Inhalt Selection von Wb zu anderem Wb
21.10.2017 09:41:15
Wb
Hallo Peter,
ich hab dein Original-Makro mal korrigiert. Waren ein paar Syntaxfehler drin und das Abschalten der Warnmeldung bei vorhandenem Namen hab ich eingebaut.
Hinweis: Wenn man Variablen deklariert, dann sollte man konsequent ale Variablen deklarieren.
Zusätzlich eine Kurzfassung.
Gruß
Franz

Sub Auswahl_in_andere_Datei()
Dim ThisWb As Workbook, OtherWB As Workbook
Dim ThisSh As Worksheet, OtherSh As Worksheet
Dim strASh1 As String, strWB As String
Dim rngQuelle As Range, rngZiel As Range
Set ThisWb = ActiveWorkbook
strWB = Sheets("oD").Range("A2") ''Hier ist der Dateiname hinterlegt
strASh1 = ActiveWorkbook.ActiveSheet.Name
Set OtherWB = Workbooks(strWB)
Set ThisSh = ThisWb.Sheets(strASh1)
Set OtherSh = OtherWB.Sheets(strASh1)
Set rngQuelle = Selection
Set rngZiel = OtherSh.Range(rngQuelle.Address)
Application.DisplayAlerts = False
rngQuelle.Copy rngZiel
Application.DisplayAlerts = True
End Sub
Sub Auswahl_in_andere_Datei_kurz()
Dim strWB As String
strWB = Sheets("oD").Range("A2") ''Hier ist der Dateiname hinterlegt
Application.DisplayAlerts = False
Selection.Copy Workbooks(strWB).Sheets(ActiveSheet.Name).Range(Selection.Address)
Application.DisplayAlerts = True
End Sub

Anzeige
AW: Ganzer Inhalt Selection von Wb zu anderem Wb
21.10.2017 09:54:13
Wb
Option Explicit
Hallo Franz
Vielen Dank. Ich habe noch eine Frage zu den Alerts.
Nachfolgend mein "ganzes" Makro. Was mich z.B. auch irritiert ist, dass ich bei dessen Ausführung keine Alerts erhalte, obschon ich diese nicht mit Application.DisplayAlerts = False ausgeschaltet habe.
Sub Inhalt_aus_ActiveSheet_in_zweite_Datei_übertragen()
Dim Anzahl As Single, Name As String, i As Byte, lngRow As Long, rngQuelle As Range, rngZiel As  _
Range, strQuelle As String
Dim Meldung As String, ThisWb As Workbook, OtherWB As Workbook, ThisSh As Worksheet, OtherSh As  _
Worksheet
Dim Sh As Worksheet, strASh1 As String, strAsh2 As String, strWB As String
Set ThisWb = ActiveWorkbook
Set Sh = ThisWb.Sheets("oD")
Anzahl = Application.Workbooks.Count
Sh.Cells.Clear
For i = 1 To Anzahl
If Left(Application.Workbooks(i).Name, 5)  "PERSO" Then
lngRow = lngRow + 1
Sh.Range("A" & lngRow).value = Application.Workbooks(i).Name
If Sh.Range("A" & lngRow).value = ActiveWorkbook.Name Then
Sh.Range("B" & lngRow).value = 0
Else
Sh.Range("B" & lngRow).value = 1
End If
End If
Next i
'' Sortieren, damit richtige Datei als ActiveWorkbook bestimmt wird, resp. die zweite Datei am  _
richtigen Ort steht
ActiveWorkbook.Worksheets("oD").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("oD").Sort.SortFields.Add Key:=Range("B1:B2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("oD").Sort
.SetRange Range("A1:B2")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sh.Range("C" & 1).value = Application.WorksheetFunction.CountA(Range("_odCount"))
If Range("_od_Anzahl") = 2 Then
strASh1 = ActiveWorkbook.ActiveSheet.Name
strWB = Sheets("oD").Range("A2")
Workbooks(strWB).Activate
Workbooks(strWB).Worksheets(strASh1).Select  'in Tabelle 2 gleiches Worksheet auswählen
ThisWb.Activate
Else
MsgBox "Dies funktioniert nur, wenn 2 Files geöffnet sind."
End If
Set OtherWB = Workbooks(strWB)
Set ThisSh = ThisWb.Sheets(strASh1)
Set OtherSh = OtherWB.Sheets(strASh1)
Set rngQuelle = Selection
Set rngZiel = OtherSh.Range(rngQuelle.Address)
rngQuelle.Copy rngZiel.Cells(1, 1)
End Sub

Anzeige
AW: Ganzer Inhalt Selection von Wb zu anderem Wb
24.10.2017 02:31:13
Wb
Hallo Peter,
die Meldung bezüglich "Name schon vorhanden" tritt nur auf wenn im sektierten Zellbereich, der kopiert weren soll, Formeln enthalten sind, die einen Namen verwenden, der in der Zieldatei schon vorhanden ist.
Ansonsten muss man darauf achten, dass in einem Makro die Alarm-Meldung nach dem deaktivieren auch wieder aktiviert werden. Denn die letzte Einstellung bleibt in Excel bis zum Beenden von Excel aktiv.
Gruß
Franz
AW: Vielen Dank, owT
24.10.2017 08:19:33
Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige