Anzeige
Archiv - Navigation
892to896
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
892to896
892to896
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

makro / tabellenblatt kopieren...

makro / tabellenblatt kopieren...
02.08.2007 11:11:54
Sabine
hallo!
derzeit kopiere ich meine tabellenblätter als ganzes über folgendes makro:
With Workbooks(nam5).Sheets("Graph2")
Workbooks("BL-Q.xls").Sheets("Graph2").Copy After:=Workbooks("monatsbericht.xls").Sheets(1)
End With
ich möchte nun aber nicht die ganzen tabellenblätter, sondern er soll nur die Formate und die Werte kopieren, da sonst die ganze Pivot-Tabelle des Orginals mitkopiert wird...
wie kann ich dem makro übergeben, dass nur Formate und Werte übernommen werden?
lg

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Inhalte und Formate aus Sheet kopieren
02.08.2007 11:26:47
NoNet
Hallo Sabine,
das könnte mit folgendem Makro klappen :


Sub SabineKopiertTabellen()
    Dim Nam5, tblGraphName
    Nam5 = "BL-Q.xls" 'Name der Quellmappe
    tblGraphName = "Graph2" 'Name des Blattes
    With Workbooks("monatsbericht.xls")
        .Sheets.Add After:=.Sheets(1)
        .Sheets(2).Name = tblGraphName
        Workbooks(Nam5).Sheets(tblGraphName).Copy
        With Sheets(2)
            .PasteSpecial Paste:=xlValues
            .PasteSpecial Paste:=xlFormats
            .PasteSpecial Paste:=xlColumnWidths
        End With
    End With
End Sub


Ich habe es mangels dieser Dateien nicht getestet, aber von der Logik aus betrachtet, sollte es funktionieren !

Anzeige
AW: Inhalte und Formate aus Sheet kopieren
02.08.2007 13:10:00
Sabine
bekomme Laufzeitfehler 1004...
mein ganzes makro ist ja wesentlich größer...

Sub report()
Dim nam As String, nam1 As String, nam2 As String, nam3 As String, nam4 As String, nam5 As  _
String, nam6 As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
nam = ActiveWorkbook.Name
Workbooks.Open Filename:="G:\Prozesse\50_Marketing_Vertrieb\05-Berichtswesen\angebot.xls"
nam1 = ActiveWorkbook.Name
Workbooks.Open Filename:="G:\Prozesse\50_Marketing_Vertrieb\05-Berichtswesen\auftrag.xls"
nam2 = ActiveWorkbook.Name
Workbooks.Open Filename:="G:\Prozesse\50_Marketing_Vertrieb\05-Berichtswesen\Qvolume_Bookings. _
xls"
nam3 = ActiveWorkbook.Name
Workbooks.Open Filename:="G:\Prozesse\50_Marketing_Vertrieb\05-Berichtswesen\BookTasCs.xls"
nam4 = ActiveWorkbook.Name
Workbooks.Open Filename:="G:\Prozesse\50_Marketing_Vertrieb\05-Berichtswesen\BL-Q.xls"
nam5 = ActiveWorkbook.Name
Workbooks.Open Filename:="G:\Prozesse\50_Marketing_Vertrieb\05-Berichtswesen\Ro12sales.xls"
nam6 = ActiveWorkbook.Name
With Workbooks(nam3).Sheets("Graph4")
Workbooks("Qvolume_Bookings.xls").Sheets("Graph4").Copy After:=Workbooks(" _
monatsbericht.xls").Sheets(1)
End With
With Workbooks(nam4).Sheets("Graph3")
Workbooks("BookTasCs.xls").Sheets("Graph3").Copy After:=Workbooks("monatsbericht.xls"). _
Sheets(1)
End With
With Workbooks(nam5).Sheets("Graph2")
Workbooks("BL-Q.xls").Sheets("Graph2").Copy After:=Workbooks("monatsbericht.xls"). _
Sheets(1)
End With
With Workbooks(nam6).Sheets("Graph1")
Workbooks("Ro12sales.xls").Sheets("Graph1").Copy After:=Workbooks("monatsbericht.xls"). _
Sheets(1)
End With
With Workbooks(nam1).Sheets("Q-Volume")
Workbooks("angebot.xls").Sheets("Q-Volume").Copy After:=Workbooks("monatsbericht.xls"). _
Sheets(1)
End With
With Workbooks(nam2).Sheets("bookings_y_cy")
Workbooks("auftrag.xls").Sheets("bookings_y_cy").Copy After:=Workbooks("monatsbericht. _
xls").Sheets(1)
End With
With Workbooks(nam2).Sheets("TA_sales_NY")
Workbooks("auftrag.xls").Sheets("TA_sales_NY").Copy After:=Workbooks("monatsbericht. _
xls").Sheets(1)
End With
With Workbooks(nam2).Sheets("sales_cy")
Workbooks("auftrag.xls").Sheets("sales_cy").Copy After:=Workbooks("monatsbericht.xls"). _
Sheets(1)
End With
With Workbooks(nam2).Sheets("bookings_mo_cy")
Workbooks("auftrag.xls").Sheets("bookings_mo_cy").Copy After:=Workbooks("monatsbericht. _
xls").Sheets(1)
End With
With Workbooks(nam1).Sheets("Lost Bids")
Workbooks("angebot.xls").Sheets("Lost Bids").Copy After:=Workbooks("monatsbericht.xls" _
).Sheets(1)
End With
With Workbooks(nam1).Sheets("TA_quotations")
Workbooks("angebot.xls").Sheets("TA_quotations").Copy After:=Workbooks("monatsbericht. _
xls").Sheets(1)
End With
End Sub


und alle außer die 4 graphs zu beginn sollen so "spezial" gepastet werden...

Anzeige
Ich habe Dein MAkro mal etwas überarbeitet
02.08.2007 14:24:00
NoNet
Hallo Sabine,
Von mehreren Dateien hattest Du im Ausgangspost nichts geschrieben, das konnte ja niemand ahnen....Dein Makro enthielt leider unzählige WITH-Anweisungen, die total überflüssig waren, da Du sie innerhalb der WITH-Struktur überhaupt nicht referenziert hattest ! Dadurch entstanden natürlich auch zahlreiche redundante Dateinamen, die ich im Folgenden mal eliminiert habe.
Mein Makro enthielt ebenfalls 2 kleine Fehler :
- Man muss die CELLS kopieren, um mit PASTESPECIAL zu arbeiten
- Die vermeintliche Excel-Konstante xlColumnWidths ist ein BUG und muss durch den Wert 8 ersetzt werden
Diese Inhalte nun zusammengemixt, korrigiert und optimiert ergibt folgende übersichtlichen Makros (die ich wieder nicht getestet habe) :
Sub report()
    Dim nam As String, namWB(1 To 6) As String, Pfad As String, WB As Long
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    nam = ActiveWorkbook.Name
    namWB = Array("angebot.xls", "auftrag.xls", "Qvolume_Bookings.xls", "BookTasCs.xls", _
                    "BL-Q.xls", "Ro12sales.xls")
    Pfad = "G:\Prozesse\50_Marketing_Vertrieb\05-Berichtswesen\" 'Mit "\" am Ende !!
    For WB = 1 To UBound(namWB)
        Workbooks.Open Filename:=Pfad & namWB(WB)
    Next
    With Workbooks("monatsbericht.xls")
        Workbooks(namWB(3)).Sheets("Graph4").Copy After:=.Sheets(1)
        Workbooks(namWB(4)).Sheets("Graph3").Copy After:=.Sheets(1)
        Workbooks(namWB(5)).Sheets("Graph2").Copy After:=.Sheets(1)
        Workbooks(namWB(6)).Sheets("Graph1").Copy After:=.Sheets(1)
    End With
    KopiereSpezial namWB(1), "Q-Volume"
    KopiereSpezial namWB(2), "bookings_y_cy"
    KopiereSpezial namWB(2), "bookings_y_cy"
    KopiereSpezial namWB(2), "TA_sales_NY"
    KopiereSpezial namWB(2), "sales_cy"
    KopiereSpezial namWB(2), "bookings_mo_cy"
    KopiereSpezial namWB(1), "Lost Bids"
    KopiereSpezial namWB(1), "TA_quotations"
End Sub
Sub KopiereSpezial(WB As String, ws As String)
    With Workbooks("monatsbericht.xls")
        .Sheets.Add After:=.Sheets(1)
        .Sheets(2).Name = ws
        Workbooks(WB).Sheets(ws).Cells.Copy
        With .Sheets(2).Cells
            .PasteSpecial Paste:=xlValues
            .PasteSpecial Paste:=xlFormats
            .PasteSpecial Paste:=8 'xlColumnWidths ist ein BUG !
        End With
    End With
End Sub

Anzeige
AW: Ich habe Dein MAkro mal etwas überarbeitet
02.08.2007 14:42:02
Sabine
hallo!
nun hab ich fehler beim kompilieren - keine zuweisung an datenfeld möglich bei folgender Zeile:
namWB = Array("angebot.xls", "auftrag.xls", "Qvolume_Bookings.xls", "BookTasCs.xls", _
"BL-Q.xls", "Ro12sales.xls")
lg

Du hast Recht : ARRAY-Fehler :-((
02.08.2007 15:01:38
NoNet
Sorry Sabine,
bei mir meckerte Excel nun auch bei der Definition des ARRAYs. Anscheinend ist es nicht möglich, eine ARRAY-Variable als String zu definieren und ihr dann ein ARRAY mit Texten zuzuweisen ?
Sei's drum : Ich habe das nun ohne "As String" und ohne die Angabe der Größe definiert (Erst danach wieder neu definiert) und zusätzlich noch .Value bei der Parametrisierung des Makros "KopiereSpezial" hinzugefügt, da Excel da auch gemeckert hat.
So sieht das Makro nun aus (mangels Dateien wieder nicht getestet - aber das machst ja DU ;-)) :
Option Explicit
Sub report()
    Dim nam As String, Pfad As String, WB As Long
    Dim namWB 'Als ARRAY nicht möglich ?
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    nam = ActiveWorkbook.Name
    namWB = Array("angebot.xls", "auftrag.xls", "Qvolume_Bookings.xls", "BookTasCs.xls", _
                    "BL-Q.xls", "Ro12sales.xls")
    ReDim Preserve namWB(1 To UBound(namWB) + 1) 'ARRAY neu nummerieren : Ab 1
    Pfad = "G:\Prozesse\50_Marketing_Vertrieb\05-Berichtswesen\" 'Mit "\" am Ende !!
    For WB = 1 To UBound(namWB)
        Workbooks.Open Filename:=Pfad & namWB(WB)
    Next
    With Workbooks("monatsbericht.xls")
        Workbooks(namWB(3)).Sheets("Graph4").Copy After:=.Sheets(1)
        Workbooks(namWB(4)).Sheets("Graph3").Copy After:=.Sheets(1)
        Workbooks(namWB(5)).Sheets("Graph2").Copy After:=.Sheets(1)
        Workbooks(namWB(6)).Sheets("Graph1").Copy After:=.Sheets(1)
    End With
    KopiereSpezial namWB(1).Value, "Q-Volume"
    KopiereSpezial namWB(2).Value, "bookings_y_cy"
    KopiereSpezial namWB(2).Value, "bookings_y_cy"
    KopiereSpezial namWB(2).Value, "TA_sales_NY"
    KopiereSpezial namWB(2).Value, "sales_cy"
    KopiereSpezial namWB(2).Value, "bookings_mo_cy"
    KopiereSpezial namWB(1).Value, "Lost Bids"
    KopiereSpezial namWB(1).Value, "TA_quotations"
End Sub
Sub KopiereSpezial(WB As String, ws As String)
    With Workbooks("monatsbericht.xls")
        .Sheets.Add After:=.Sheets(1)
        .Sheets(2).Name = ws
        Workbooks(WB).Sheets(ws).Cells.Copy
        With .Sheets(2).Cells
            .PasteSpecial Paste:=xlValues
            .PasteSpecial Paste:=xlFormats
            .PasteSpecial Paste:=8 'xlColumnWidths ist ein BUG !
        End With
    End With
End Sub
Grüße, NoNet

Anzeige
Objektfehler :(
02.08.2007 15:15:32
Sabine
Hi!
die grafiken importiert er und bei der 1. KopiereSpezialZeile bekomm ich dann Laufzeitfehler 424 - Objekt erforderlich :(

OK : .Value wieder raus bei Kopierespezial
02.08.2007 15:38:00
NoNet
Hallo Sabine,
Du hältst mich mittlerweile wohl schon für völlig unfähig, oder ;-) ?
So komme ich mir aber auch fast vor (nach "erst" 12 Jahren VBA-Programmiererfahrung ;-).
Im ersten Code hat Excel ohne ".Value" gemeckert, jetzt meckert er MIT ".Value".
Also : Wieder weg damit, dann hat es in meinem Probelauf (Nur MsgBox, ohne Dateien Öffnen oder Kopieren) auch funktioniert.
Viel Erfolg (bin in ca. 15 Min. leider unterwegs und ncht mehr am PC)
Gruß, NoNet

Anzeige
Fehler: Argumenttyp byRef unverträglich
02.08.2007 15:50:17
Sabine
irgendwie mag mich das makro anscheinend nicht... neuer Fehler Argumenttyp ByRef unverträglich - bei zeile KopiereSpezial namWB(2), "TA_bookings_Y_CY"

könnte es daran liegen?
02.08.2007 16:24:00
Sabine
variable namWB hat keinen typ (string, long, ...) usw?

AW: könnte es daran liegen?
02.08.2007 22:40:00
Herbert
Hi,
übergib das Argument ByVal, denn ByRef verlangt den exakten Datentyp.
mfg Herbert

AW: könnte es daran liegen?
02.08.2007 23:58:53
Sabine
wie mach ich denn das?

Sub xyz(ByVal x As type, ...) s.a. "Sub" bzw...
03.08.2007 05:32:29
Luc:-?
...Prozedurdeklaration in der VBA-Editor-Hilfe, Sabine!
Gruß Luc :-?

danke funktioniert!!!
03.08.2007 08:24:00
Sabine
lg

Erledigt oT
03.08.2007 14:39:00
.
o

309 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige