Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1776to1780
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
Makro Code "Kopieren" ergänzen
26.08.2020 14:37:43
Andreas

Hallo Excelfreunde,
Ich benötige bitte Hilfe zum bereits erstellten Code.
Folgende Vorgehensweise:
Ich habe zwei Dateien im gleichen Ordner auf einem Gruppenlaufwerk
Datei1 ist die Masterdatei
Datei2 ist die Quelldatei
Folgendes soll passieren:
Ich öffne die "Masterdatei" und anschließend über einen CommandButton die "Quelldatei"
in der "Quelldatei" werden aus verschiedenen Tabellen die Daten aufbereitet und im Tabellenblatt "Auswertung" zur Verfügung gestellt.
Der Tabellenbereich (Bereich der anschließend in die Masterdatei kopiert werden soll) ist im Tabellenblatt "Auswertung" immer von .Range("C5:P" & Loletzte) (variabel)
das heißt das Spalte C:P immer gleich bleiben nur die Zeilenanzahl ab Zeile5 bis letzte belegte Zeile in Spalte "P" ist variabel.
Ich möchte das der komplette Bereich von der "Quelldatei" .Range("C5:P" & Loletzte) .copy
in die Masterdatei Worksheets("Erfassung_Bearbeitung") ab "AN5:BA" wieder eingefügt wird. (nur Werte)
mein bereits erstelltes Makro funktioniert bisher nur bis zur Codezeile wo der Kopierrahmen erstellt wird.
das einfügen der Daten dann in die Masterdatei Tabellenblatt "Erfassung_Bearbeiung" ab Zelle "AN5" will einfach nicht klappen.
Kann mir jemand den bereits erstellten Code diesbezüglich abändern oder ergänzen?
Wäre echt dankbar über eure Hilfe.
Hier der bereits erstellte Code:
Sub AuswahlKatalogvorgang()
Dim r As Long, c As Long
Dim sPfadQuelle As String
Dim sDateiQuelle As String
Dim TabellenblattZiel As String
Dim sName As String
Dim w As Integer
Dim sw As Boolean
Dim loletzte As Long
loletzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
Count) + 1
'Dim lastRow As Long
'lastRow = Worksheets("Tabelle1").Cells(Rows.Count, "B").End(xlUp).Row
sPfadQuelle = ThisWorkbook.Path & "\"
sDateiQuelle = "Admin_PM aktuelle Ressourcenplanung_10.08.2020.xlsm"
sZiel = "Erfassung_Bearbeitung"     'einfügen ab "AN5"
'es wird geprüft ob die Datei die geöffnet werden soll im selben Verzeichnis vorhanden ist   _
_
und bereits geöffnet ist
For w = 1 To Workbooks.Count
If Workbooks(w).Name = sDateiQuelle Then
sw = True
End If
Next w
If sw = False Then
sName = Dir(sPfadQuelle & sDateiQuelle)
If sName = "" Then
'wenn Datei nicht vorhanden ist wird Meldung ausgegeben
MsgBox sDateiQuelle & " nicht gefunden !", vbCritical
Exit Sub
End If
Workbooks.Open sPfadQuelle & sDateiQuelle
ThisWorkbook.Activate
End If
MsgBox "bis hierhin ist alles oK"
Worksheets("Auswertung").Activate
MsgBox "Tabelle Auswertung ist aktiviert"
Range("C5:P" & loletzte).Copy
MsgBox "Kopierrahmen ist vorhanden"
' bis hierhin läuft mein Makro bereits ohne Probleme
'++++ hier meine bereits vergeblichen Versuche +++++
'++++ was mache ich Falsch ++++
'Workbooks(sDateiQuelle).Worksheets("Erfassung_Bearbeitung").Cells(5, 40).PasteSpecial Paste:=  _
_
xlValues
'Workbooks("Admin_PM aktuelle Ressourcenplanung_10.08.2020.xlsm").Worksheets(" _
Erfassung_Bearbeitung").Range("AN5").PasteSpezial Paste:=xlPasteValues
'Workbooks(sPfadQuelle & sDateiQuelle & TabellenblattZiel).Activate    'Worksheets(" _
Erfassung_Bearbeitung").Activate
'Set wsZiel = Workbooks(sPfadQuelle & sDateiQuelle)         '.Worksheets(" _
Erfassung_Bearbeitung")
'wsZiel.Worksheets("Erfassung_Bearbeitung").Cells(7, 40).PasteSpecial Paste:=xlPasteValues
'Worksheets("Erfassung_Bearbeitung").Activate
End Sub

Vielen Dank im voraus für Eure Hilfe
liebe Grüße Andreas

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

Betreff
Datum
Anwender
Anzeige
AW: Makro Code "Kopieren" ergänzen
26.08.2020 16:33:48
Werner
Hallo,
teste mal:
Option Explicit
Sub AuswahlKatalogvorgang()
Dim sPfadQuelle As String, sDateiQuelle As String, sName As String
Dim w As Long, sw As Boolean, loletzte As Long, wbQuelle As Workbook
sPfadQuelle = ThisWorkbook.Path & "\"
sDateiQuelle = "Admin_PM aktuelle Ressourcenplanung_10.08.2020.xlsm"
For w = 1 To Workbooks.Count
If Workbooks(w).Name = sDateiQuelle Then
Set wbQuelle = Workbooks(sDateiQuelle)
sw = True
Exit For
End If
Next w
If sw = False Then
sName = Dir(sPfadQuelle & sDateiQuelle)
If sName = "" Then
MsgBox sDateiQuelle & " nicht gefunden !", vbCritical
Exit Sub
Else
Set wbQuelle = Workbooks.Open(sPfadQuelle & sDateiQuelle)
End If
End If
With wbQuelle.Worksheets("Auswertung")
loletzte = .Cells(.Rows.Count, "P").End(xlUp).Row
.Range("C5:P" & loletzte).Copy
ThisWorkbook.Worksheets("Erfassung_Bearbeitung").Range("AN5").PasteSpecial _
Paste:=xlPasteValues
End With
Application.CutCopyMode = False
wbQuelle.Close False
Set wbQuelle = Nothing
End Sub
Gruß Werner
Anzeige
AW: Makro Code "Kopieren" ergänzen
26.08.2020 16:42:58
Andreas
Hallo Werner,
Danke jetzt habe ich es wie ich es wollte.
Super ist ein tolles Forum hier
Liebe Grüße Andreas
Gerne u. Danke für die Rückmeldung. o.w.T.
26.08.2020 16:51:44
Werner

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige