Thema Datum  Von Nutzer Rating
Antwort
Rot Daten Import aus zweiten Tabelle
29.12.2016 12:51:05 vb_newbie
NotSolved
29.12.2016 13:11:01 Onur
NotSolved
29.12.2016 13:20:30 vb_newbie
NotSolved
29.12.2016 14:01:35 Onur
Solved
30.12.2016 14:48:34 vb_newbie
Solved

Ansicht des Beitrags:
Von:
vb_newbie		 Datum:
29.12.2016 12:51:05		 Views:
1269		 Rating:
     
Antwort:
  Ja
Thema:
Daten Import aus zweiten Tabelle

Hallo,

ich importiere Daten aus einer anderen Tabelle (Quelle.xlsm) und kopiere mehrere der Sheets (Alpha, Beta, Gamma...) jeweis den Bereich A1 bis A500 in Eingabe.xlsm meine arbetis Tabelle mit dem Sheets Namen Auswertung in Spalte A2, B2, C2, D2 und E2. 

Zum auswählen der Quelldatei verwende ich DateiÖffnen Dialog, so weit so gut funktioniert auch alles.

Jedoch möchte ich das überspringen, wenn die Quelle.xlsm bereiches geöffnet ist, damit ich immer die aktuellen Daten kopiere.

Kann mir bitte jemand den Code mit der passenden funktion erweitern

Dankeschön

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Option Explicit
 
Sub Daten_Importieren()
  Dim WBZiel As Workbook
  Dim ExportDatei As Variant
  Dim WBQuelle As Workbook
  Dim WSZiel As Worksheet
   
  Set WBZiel = ThisWorkbook
   
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
   
  'DateiÖffnen Dialog anbieten
  ExportDatei = Application.GetOpenFilename("Excel-Dateien, *.xlsm", , "Bitte die Datei zum Kopieren öffnen ...")
  ExportDatei = CStr(ExportDatei)
   
  If ExportDatei = "Falsch" Then Exit Sub
  'öffnen der ausgewählten Datei
  Set WBQuelle = Workbooks.Open(ExportDatei)
  'kopieren des Blattinhaltes und Schließen der Quell-Datei wenn nötig
  With WBQuelle
     .Sheets("Alpha").Range("A3:A500").Copy WBZiel.Sheets("Auswertung").Range("A2")
     .Sheets("Beta").Range("A3:A500").Copy WBZiel.Sheets("Auswertung").Range("B2")
     .Sheets("Gamma").Range("A3:A500").Copy WBZiel.Sheets("Auswertung").Range("C2")
     .Sheets("Delta").Range("A3:A500").Copy WBZiel.Sheets("Auswertung").Range("D2")
     .Sheets("Epsilon").Range("A3.A500").Copy WBZiel.Sheets("Auswertung").Range("E2")
     '.Close savechanges:=False ' Tabelle Schließen
  End With
  WBZiel.Sheets("Auswertung").Activate
   
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
 
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Daten Import aus zweiten Tabelle
29.12.2016 12:51:05 vb_newbie
NotSolved
29.12.2016 13:11:01 Onur
NotSolved
29.12.2016 13:20:30 vb_newbie
NotSolved
29.12.2016 14:01:35 Onur
Solved
30.12.2016 14:48:34 vb_newbie
Solved