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 Diagramme mit Makros erstellen - mehrer tabellenabschnitte

Frage Microsoft Microsoft Office

Mitglied: hassati

hassati (Level 1) - Jetzt verbinden

10.08.2009, aktualisiert 11.09.2009, 5040 Aufrufe

Hallo,


ich möchte aus mehreren Excel Files die Tabellen im ersten Sheet in ein einziges Excel File kopieren.
Dabei sollen die Tabellen im neuem Excel File jeweils in einem extra sheet kopiert werden.

Hab ein Makro gefunden, jedoch kopiert das Makro die Tabellen in ein einziges Sheet:

01.
Option Explicit 
02.
Private Type BrowseInfo 
03.
hwndOwner As Long 
04.
pIDLRoot As Long 
05.
pszDisplayName As Long 
06.
lpszTitle As Long 
07.
ulFlags As Long 
08.
lpfnCallback As Long 
09.
lParam As Long 
10.
iImage As Long 
11.
End Type 
12.
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long 
13.
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pIDList As Long, ByVal lpBuffer As String) As Long 
14.
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long 
15.
Sub makro01() 
16.
Dim i As Integer, letzte As Integer 
17.
Application.DisplayAlerts = False 
18.
With Application.FileSearch 
19.
.NewSearch 
20.
.LookIn = Ordnerwählen("Ab welchem Verzeichnis einlesen?") 
21.
.SearchSubFolders = False 
22.
.Filename = "*.xls" 
23.
If .Execute() > 0 Then 
24.
x = 1 
25.
For i = 1 To .FoundFiles.Count 
26.
Workbooks.Open Filename:=.FoundFiles(i) 
27.
 
28.
Rem hier deine bereichsangaben leicht anpassbar sind 
29.
 
30.
Workbooks(2).Sheets(1).Range("A3:C60", "F3:F60").Copy 
31.
 
32.
letzte = Workbooks(1).Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 
33.
Workbooks(1).Sheets(1).Cells(letzte, 1).Insert Shift:=xlDown 
34.
Workbooks(2).Sheets(x).Application.CutCopyMode = False 
35.
Workbooks(2).Close 
36.
x = x + 1 
37.
Next i 
38.
End If 
39.
End With 
40.
Application.DisplayAlerts = True 
41.
End Sub 
42.
Private Function Ordnerwählen(ByVal strTitle As String) As String 
43.
Dim lngIDList As Long 
44.
Dim strBuffer As String 
45.
Dim UserBrowseInfo As BrowseInfo 
46.
With UserBrowseInfo 
47.
.hwndOwner = 0 
48.
.lpszTitle = lstrcat(strTitle, "") 
49.
.ulFlags = 3 
50.
End With 
51.
lngIDList = SHBrowseForFolder(UserBrowseInfo) 
52.
If (lngIDList) Then 
53.
strBuffer = Space(260) 
54.
SHGetPathFromIDList lngIDList, strBuffer 
55.
strBuffer = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1) 
56.
Ordnerwählen = strBuffer 
57.
End If 
58.
End Function
[Edit Biber] Codetags nachgetragen [/Edit]
Ähnliche Inhalte
Microsoft Office
Excel 2010 Doc Properties ohne Makros (1)

Frage von arduino zum Thema Microsoft Office ...

Microsoft Office
Wieso druckt PDF keine Excel Zellenfüllung? (4)

Frage von ITCrowdSupporter zum Thema Microsoft Office ...

Neue Wissensbeiträge
Batch & Shell

Batch als Dienst bei Systemstart ohne Anmeldung ausführen

(3)

Tipp von tralveller zum Thema Batch & Shell ...

Sicherheits-Tools

Sicherheitstest von Passwörtern für ganze DB-Tabellen

(1)

Tipp von gdconsult zum Thema Sicherheits-Tools ...

Peripheriegeräte

Was beachten bei der Wahl einer USV Anlage im Serverschrank

(9)

Tipp von zetboxit zum Thema Peripheriegeräte ...

Heiß diskutierte Inhalte
Exchange Server
Exchange 2016 Standard Server 2012 R2 Hetzner Mail (41)

Frage von Datsspeed zum Thema Exchange Server ...

Windows 7
gelöst Lokales Adminprofil defekt (25)

Frage von Yannosch zum Thema Windows 7 ...

Off Topic
gelöst Fachzeitschriften als E-Book oder hardcoded? (11)

Frage von KowaKowalski zum Thema Off Topic ...

Windows 10
Windows Store Apps ohne Windows Store installieren (10)

Frage von keefien zum Thema Windows 10 ...