|
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
02.11.2008 19:22:48 |
Sebastian23 |
|
|
|
02.11.2008 21:55:06 |
jh |
|
|
|
10.11.2008 19:26:00 |
Sebastian23 |
|
|
 Aw:Aw:Aw:Externe Tabellenblätter importieren/expor |
12.11.2008 20:33:15 |
jh |
|
|
|
12.11.2008 21:35:30 |
Sebastian23 |
|
|
Von:
jh |
Datum:
12.11.2008 20:33:15 |
Views:
1258 |
Rating:
|
Antwort:
|
Thema:
Aw:Aw:Aw:Externe Tabellenblätter importieren/expor |
Hallo
sorry, habe deine Rückfrage erst heute bemerkt, weil der Thread schon
von der ersten Seite verschwunden ist. Das mit den in der Zieldatei
schon existierenden Tabellen wäre natürlich vorher gut zu wissen
gewesen. Um nicht wieder Code an deinem tatsächlichen Bedarf vorbei
zu schreiben, geht das folgende Beispiel davon aus, dass die zu
kopierenden Tabellen in der Zieldatei schon existieren KÖNNEN, aber
nicht MÜSSEN. Bei schon existierenden Tabellen wird in der Zieldatei
nur deren Inhalt gelöscht und dafür der Inhalt der zu kopierenden
Tabelle eingefügt, anderenfalls wird die komplette Tabelle kopiert.
Falls der letztere Fall gar nicht auftritt, ist das auch nicht
schlimm, dann wird der entsprechende If-Zweig eben normalerweise
nie durchlaufen und ist nur eine "Fehlerreserve" für den Fall,
dass es vielleicht irgendwann doch mal der Fall ist.
Private Sub TabellenImportieren()
Dim wkbSource As Workbook
Dim wkbDestination As Workbook
Dim wkbA As Workbook
Dim wksA As Worksheet
Dim strPathAndFilename As String
Dim vntSplit As Variant
Dim strFilename As String
Dim blnWkbOpen As Boolean
Dim lngR As Long
Dim intC As Integer
strPathAndFilename = Application.GetOpenFilename( _
FileFilter:="MS-Excel-Arbeitsmappe (*.xls), *.xls", _
Title:="Importieren")
If Not strPathAndFilename = "Falsch" Then
vntSplit = Split(strPathAndFilename, Application.PathSeparator)
strFilename = vntSplit(UBound(vntSplit))
' prüfen, ob Quelldatei schon geöffnet ist
For Each wkbA In Workbooks
If wkbA.Name = strFilename Then
blnWkbOpen = True
Exit For
End If
Next wkbA
Application.ScreenUpdating = False
If blnWkbOpen = True Then
Set wkbSource = wkbA
Else
Set wkbSource = Workbooks.Open(FileName:=strPathAndFilename)
End If
Set wkbDestination = ThisWorkbook
For Each wksA In wkbSource.Worksheets
If SheetExists(wkbDestination, wksA.Name) = False Then
wksA.Copy After:=wkbDestination.Worksheets( _
wkbDestination.Worksheets.Count)
Else
wkbDestination.Worksheets(wksA.Name).UsedRange.ClearContents
lngR = wksA.UsedRange.Rows(wksA.UsedRange.Rows.Count).Row + 1
intC = wksA.UsedRange.Columns(wksA.UsedRange.Columns.Count).Column
wksA.Range(wksA.Cells(1, 1), wksA.Cells(lngR, intC)).Copy _
Destination:=wkbDestination.Worksheets(wksA.Name).Range("A1")
End If
Next wksA
If blnWkbOpen = False Then
wkbSource.Close SaveChanges:=False
End If
Application.ScreenUpdating = True
End If
End Sub
Private Function SheetExists(wkbA As Workbook, _
strSheetName As String) As Boolean
Dim wksA As Worksheet
For Each wksA In wkbA.Worksheets
If wksA.Name = strSheetName Then
SheetExists = True
Exit For
End If
Next wksA
End Function
Gruß
|
- 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
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- 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
|
|
02.11.2008 19:22:48 |
Sebastian23 |
|
|
|
02.11.2008 21:55:06 |
jh |
|
|
|
10.11.2008 19:26:00 |
Sebastian23 |
|
|
Aw:Aw:Aw:Externe Tabellenblätter importieren/expor |
12.11.2008 20:33:15 |
jh |
|
|
|
12.11.2008 21:35:30 |
Sebastian23 |
|
|