Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Excel Datei in mehrere splitten und per mail versenden

Frage Microsoft Microsoft Office

Mitglied: Flying.Viper

Flying.Viper (Level 1) - Jetzt verbinden

17.08.2011 um 14:28 Uhr, 1995 Aufrufe, 2 Kommentare

Hallo,

ich steh vor einer etwas spezielleren Herausforderung:

ich habe eine Ausgangsdatei, welche ich mittels nachfolgendem makro, nach einem Kriterium in 18 einzelne Dateien aufsplitte

01.
Option Explicit 
02.
Sub Pivotrefresh() 
03.
 
04.
    Worksheets("Pivot").Activate 
05.
    ActiveSheet.PivotTables("PivotTable8").PivotCache.Refresh 
06.
     
07.
End Sub 
08.
 
09.
Sub Start() 
10.
 
11.
Dim I As Byte, K As Integer, X As Integer, Y As Integer 
12.
Dim Kriterium As String, Pfad As String 
13.
Dim AW As String 
14.
 
15.
'Dies bitte anpassen => Pfad, wo gespeichert werden soll 
16.
Pfad = "C:\" 
17.
 
18.
'Bildschirmaktualisierung abschalten 
19.
Application.ScreenUpdating = False 
20.
 
21.
'Datenbasis neu aufstellen 
22.
Pivotrefresh 
23.
 
24.
'Zum richtigen Tabellenblatt springen 
25.
Worksheets("Quelle").Activate 
26.
 
27.
'Ende der Quelle finden 
28.
Worksheets("Quelle").Cells(Rows.Count, 2).End(xlUp).Activate 
29.
K = Replace(ActiveCell.Address(False, False), "B", "") 
30.
 
31.
'Beginn in Zeile => Pivottabelle 
32.
I = 5 
33.
 
34.
'Loslaufen 
35.
Do 
36.
 
37.
    'Ersten Eintrag der zu filternden Kriterien 
38.
    Kriterium = Worksheets("Pivot").Cells(I, 1) 
39.
       
40.
    'Für jedes Kriterium ein Tabellenblatt 
41.
    Worksheets.Add 
42.
    ActiveSheet.Name = Kriterium 
43.
     
44.
    'Zunächst die Überschriften setzen 
45.
    Worksheets(Kriterium).Cells(1, 1) = Worksheets("Quelle").Cells(1, 1) 
46.
    Worksheets(Kriterium).Cells(1, 2) = Worksheets("Quelle").Cells(1, 2) 
47.
    Worksheets(Kriterium).Cells(1, 3) = Worksheets("Quelle").Cells(1, 3) 
48.
    Worksheets(Kriterium).Cells(1, 4) = Worksheets("Quelle").Cells(1, 4) 
49.
    Worksheets(Kriterium).Cells(1, 5) = Worksheets("Quelle").Cells(1, 5) 
50.
    Worksheets(Kriterium).Cells(1, 6) = Worksheets("Quelle").Cells(1, 6) 
51.
    Worksheets(Kriterium).Cells(1, 7) = Worksheets("Quelle").Cells(1, 7) 
52.
    Worksheets(Kriterium).Cells(1, 8) = Worksheets("Quelle").Cells(1, 8) 
53.
    Worksheets(Kriterium).Cells(1, 9) = Worksheets("Quelle").Cells(1, 9) 
54.
    Worksheets(Kriterium).Cells(1, 10) = Worksheets("Quelle").Cells(1, 10) 
55.
    Worksheets(Kriterium).Cells(1, 11) = Worksheets("Quelle").Cells(1, 11) 
56.
    Worksheets(Kriterium).Cells(1, 12) = Worksheets("Quelle").Cells(1, 12) 
57.
    Worksheets(Kriterium).Cells(1, 13) = Worksheets("Quelle").Cells(1, 13) 
58.
    Worksheets(Kriterium).Cells(1, 14) = Worksheets("Quelle").Cells(1, 14) 
59.
    Worksheets(Kriterium).Cells(1, 15) = Worksheets("Quelle").Cells(1, 15) 
60.
    Worksheets(Kriterium).Cells(1, 16) = Worksheets("Quelle").Cells(1, 16) 
61.
    Worksheets(Kriterium).Cells(1, 17) = Worksheets("Quelle").Cells(1, 17) 
62.
         
63.
    'Zeile in jedem Tabellenblatt wieder auf zwei setzen 
64.
    Y = 2 
65.
     
66.
    'Die Quelle vom Anfang bis Ende durchlaufen 
67.
    For X = 2 To K 
68.
       
69.
        'Sofern Kriterium entspricht, kopieren 
70.
        If Worksheets("Quelle").Cells(X, 2) = Kriterium Then 
71.
             
72.
            Worksheets(Kriterium).Cells(Y, 1) = Worksheets("Quelle").Cells(X, 1) 
73.
            Worksheets(Kriterium).Cells(Y, 2) = Worksheets("Quelle").Cells(X, 2) 
74.
            Worksheets(Kriterium).Cells(Y, 3) = Worksheets("Quelle").Cells(X, 3) 
75.
            Worksheets(Kriterium).Cells(Y, 4) = Worksheets("Quelle").Cells(X, 4) 
76.
            Worksheets(Kriterium).Cells(Y, 5) = Worksheets("Quelle").Cells(X, 5) 
77.
            Worksheets(Kriterium).Cells(Y, 6) = Worksheets("Quelle").Cells(X, 6) 
78.
            Worksheets(Kriterium).Cells(Y, 7) = Worksheets("Quelle").Cells(X, 7) 
79.
            Worksheets(Kriterium).Cells(Y, 8) = Worksheets("Quelle").Cells(X, 8) 
80.
            Worksheets(Kriterium).Cells(Y, 9) = Worksheets("Quelle").Cells(X, 9) 
81.
            Worksheets(Kriterium).Cells(Y, 10) = Worksheets("Quelle").Cells(X, 10) 
82.
            Worksheets(Kriterium).Cells(Y, 11) = Worksheets("Quelle").Cells(X, 11) 
83.
            Worksheets(Kriterium).Cells(Y, 12) = Worksheets("Quelle").Cells(X, 12) 
84.
            Worksheets(Kriterium).Cells(Y, 13) = Worksheets("Quelle").Cells(X, 13) 
85.
            Worksheets(Kriterium).Cells(Y, 14) = Worksheets("Quelle").Cells(X, 14) 
86.
            Worksheets(Kriterium).Cells(Y, 15) = Worksheets("Quelle").Cells(X, 15) 
87.
            Worksheets(Kriterium).Cells(Y, 16) = Worksheets("Quelle").Cells(X, 16) 
88.
            Worksheets(Kriterium).Cells(Y, 17) = Worksheets("Quelle").Cells(X, 17) 
89.
            Y = Y + 1 
90.
             
91.
        End If 
92.
         
93.
    Next X 
94.
     
95.
    'Neue Mappe aufmachen und Tabellenblatt verschieben 
96.
    Sheets(Kriterium).Move 
97.
    ActiveWorkbook.SaveAs Filename:=Pfad & "\" & Kriterium & ".xls", FileFormat:= _ 
98.
        xlNormal, CreateBackup:=False 
99.
     
100.
    'Aktives Tabellenblatt schließen. Änderungen wurden bereits gespeichert! 
101.
    ActiveWorkbook.Close 
102.
     
103.
    'Nächste Runde 
104.
    I = I + 1 
105.
     
106.
Loop Until Worksheets("Pivot").Cells(I, 1) = "Gesamtergebnis" 
107.
 
108.
AW = MsgBox("Der Vorgang wurde abgeschlossen!", vbOKOnly + vbInformation + vbSystemModal, "Hinweis") 
109.
 
110.
Application.ScreenUpdating = True 
111.
 
112.
End Sub



ich möchte jetzt jede Datei an eine spezielle e-mail-adresse verschicken z.B. Datei mit Kriterium A an email-adresse Y, Datei mit Kriterium B an email-adresse Z, usw.

ist das möglich, bzw. ist das mit einem makro möglich?
Mitglied: AndreasHoster
17.08.2011 um 14:51 Uhr
Natürlich kann man sowas programmieren.
Beispiel z.B. hier: http://www.rondebruin.nl/cdo.htm oder auch hier http://msdn.microsoft.com/en-us/library/aa167323(v=office.11).aspx (MSDN Beispiel für Access, aber Excel VBA ist jetzt nicht so anders).
Bitte warten ..
Mitglied: Flying.Viper
17.08.2011 um 14:57 Uhr
danke schonmal für die links, leider bin ich nicht ganz so versiert im programmieren

wie würde der code z.B. für Kriterium A und e-mail xxx@yyy.de aussehen bzw. noch viel wichtiger, wie kann ich das in mein bestehendes makro einarbeiten?

bin für jede hilfe dankbar
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(1)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Exchange Server
gelöst Exchange mehrere E-Mail Adressen und Senden Als (7)

Frage von ketanest112 zum Thema Exchange Server ...

Informationsdienste
Excel Datei ohne Download zur Verfügung stellen (4)

Frage von gnaulimon zum Thema Informationsdienste ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...