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, 5010 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 ...

Batch & Shell
gelöst Excel Farblich (3)

Frage von Berlin62 zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Exchange Server
gelöst Email in Exchange an 2ten Empfänger senden (18)

Frage von MultiStorm zum Thema Exchange Server ...

Weiterbildung
Gehaltsvorstellungen (14)

Frage von SYS64738 zum Thema Weiterbildung ...

Windows Server
gelöst Microsoft-Lizenz CALs und passendes Server-Betriebssystem (13)

Frage von planetIT2016 zum Thema Windows Server ...

Verschlüsselung & Zertifikate
gelöst Festplattenverschlüsselung im Ausland (13)

Frage von Nicolaas zum Thema Verschlüsselung & Zertifikate ...