Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
19.04.2024 13:58:02
Set Worksheet geht im O365 aber im Excel 2016 nicht
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1068to1072
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1068to1072
1068to1072
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Export von Werten

Export von Werten
27.04.2009 14:54:34
Werten
Hallo,
ich habe zu u. a. Code eine Frage:
Der Code extrahiert aus einer Exceldatei mit 7 Tabellenblätten in einer neuen Dateiu 3 Tabellenblätter und ersetzt die Formeln mit werten , was soweit auch alles perfekt funktioniert.
Nun hätte ich gerne eine Verbesserung in der Art, dass ich
1.) bestimmte Namen der Tabellenblätter explizit vorgeben kann, die ich in der Form bearbeitet haben möchte
2.) statt ganzer Tabellenblätter nur jeweils Spalte 2-9 und bis Zeile 3000 bearbeitet. Die neue Datei mit den "Werten sollte möglichst klein, deshalb dieser Wunsch!
Kann mir jemand helfen?
Gruß
Bernd
PS:
Der Code:

Sub Wertedatei()
Dim wbQ As Workbook, wbZ As Workbook
Dim i As Integer
Dim fn As String
Set wbQ = ActiveWorkbook
Application.ScreenUpdating = False
'erstes Blatt kopieren
wbQ.Sheets(1).Copy
Set wbZ = ActiveWorkbook
'weitere Blätter kopieren
For i = 2 To wbQ.Sheets.Count - 4
wbQ.Sheets(i).Copy After:=wbZ.Sheets(wbZ.Sheets.Count)
Next i
'Formeln in Werte wandeln
For i = 2 To wbQ.Sheets.Count - 4
With wbZ.Sheets(i)
.Cells.Copy
.Cells.PasteSpecial xlValues
End With
Next i
Application.CutCopyMode = False
'Dateinamen der neuen Wertedatei ermitteln
fn = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 4) & "_Werte.xls"
'Wertedatei speichern
wbZ.SaveAs Filename:=fn
wbZ.Close 'evtl. schließen?
'Ursprungsdatei schließen
wbQ.Close SaveChanges:=True
Application.ScreenUpdating = False
End Sub


6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Export von Werten
28.04.2009 09:39:14
Werten
Hall Bernd,
hier dein Makro entsprechend angepasst.
Die Namen der Tabellen mit zu kopierenden Daten muss du noch anpassen bzw. ergänzen.
Gruß
Franz

Sub Wertedatei()
Dim wbQ As Workbook, wbZ As Workbook
Dim wksQ As Worksheet, wksZ As Worksheet
Dim fn As String
Set wbQ = ActiveWorkbook
Application.ScreenUpdating = False
For Each wksQ In wbQ.Worksheets
Select Case wksQ.Name
Case "Tabelle2", "Tabelle3", "Tabelle5"
'Namen der Tabellen mit zu kopierenden Daten
If wbZ Is Nothing Then
'Neue mappe mit 1 Tabellenblatt anlegen
Workbooks.Add Template:=xlWBATWorksheet
Set wbZ = ActiveWorkbook
Set wksZ = wbZ.Worksheets(1)
Else
'Neues Tabellenblatt einfügen
wbZ.Worksheets.Add after:=wksZ
Set wksZ = ActiveSheet
End If
'Name der Zieltabelle gleich Namen der Quelle setzen
wksZ.Name = wksQ.Name
'Formate und Werte der Spalten 2 bis 9 von Quelle nach Ziel kopieren
With wksQ
.Range(.Columns(2), .Columns(9)).EntireColumn.Copy
End With
wksZ.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksZ.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Case Else
'do nothing
End Select
Next
Application.CutCopyMode = False
If Not wbZ Is Nothing Then 'Wenn Daten kopiert wurden dann
'Dateinamen der neuen Wertedatei ermitteln
fn = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 4) & "_Werte.xls"
'Wertedatei speichern
wbZ.SaveAs Filename:=fn
wbZ.Close 'evtl. schließen?
'Ursprungsdatei schließen
wbQ.Close SaveChanges:=True
End If
Application.ScreenUpdating = True
End Sub


Anzeige
AW: Export von Werten
28.04.2009 15:11:57
Werten
Hallo Franz,
leider bleibt der Code bei wksZ.Cells(1, 1).PasteSpecial Paste:=xlPasteValues hängen und zwar aufgrund verbundener Zellen.
Lässt sich der Code evtl. so flexibel gestalten, dass man pro Sheet explizit noch vorgibt, welchere Bereich (ab Zeile bis Zeile und die Spalten). Die verbunden Zellen sind im ersten 12 Zeilen eines meiner Tabellenblätter zu finden!
Gruß
Bernd
AW: Export von Werten
28.04.2009 17:37:40
Werten
Hallo Bernd,
warum gewöhnt ihr euch nicht endlich an die verbundenen Zellen zu vermeiden, insbesondere wenn VBA-Code Zellen bearbeiten soll. Die verb. Zellen sind so eine Landplage!!
Du kannst die Zellbereiche individueller festlegen, aber dann wird das Übertragen der Spaltenbreiten aufwendiger.

Sub Wertedatei()
Dim wbQ As Workbook, wbZ As Workbook
Dim wksQ As Worksheet, wksZ As Worksheet
Dim fn As String
Dim Zeile1 As Long, Zeile2 As Long, SpalteQ As Long, SpalteZ As Long
Set wbQ = ActiveWorkbook
Application.ScreenUpdating = False
For Each wksQ In wbQ.Worksheets
Select Case wksQ.Name
Case "Tabelle2", "Tabelle3", "Tabelle5"
'zu kopierende Zeielnbereiche festlegen
Select Case wksQ.Name
Case "Tabelle2"
Zeile1 = 13: Zeile2 = 3000
Case "Tabelle3"
Zeile1 = 8: Zeile2 = wksQ.Cells(wksQ.Rows.Count, 2).End(xlUp).Row
Case "Tabelle5"
Zeile1 = 10: Zeile2 = 1000
Case Else
Zeile1 = 12: Zeile2 = wksQ.Cells.SpecialCells(xlCellTypeLastCell).Row
End Select
'Namen der Tabellen mit zu kopierenden Daten
If wbZ Is Nothing Then
'Neue mappe mit 1 Tabellenblatt anlegen
Workbooks.Add Template:=xlWBATWorksheet
Set wbZ = ActiveWorkbook
Set wksZ = wbZ.Worksheets(1)
Else
'Neues Tabellenblatt einfügen
wbZ.Worksheets.Add after:=wksZ
Set wksZ = ActiveSheet
End If
'Name der Zieltabelle gleich Namen der Quelle setzen
wksZ.Name = wksQ.Name
'Formate und Werte der Spalten 2 bis 9 von Quelle nach Ziel kopieren
'Spaltenbreiten in Zieltabelle übertragen
SpalteZ = 0
For SpalteQ = 2 To 9
SpalteZ = SpalteZ + 1
wksZ.Columns(SpalteZ).ColumnWidth = wksQ.Columns(SpalteQ).ColumnWidth
Next
'Zellformate und Werte
With wksQ
.Range(.Cells(Zeile1, 2), .Cells(Zeile2, 9)).Copy
End With
wksZ.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksZ.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Case Else
'do nothing
End Select
Next
Application.CutCopyMode = False
If Not wbZ Is Nothing Then 'Wenn Daten kopiert wurden dann
'Dateinamen der neuen Wertedatei ermitteln
fn = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 4) & "_Werte.xls"
'Wertedatei speichern
wbZ.SaveAs Filename:=fn
wbZ.Close 'evtl. schließen?
'Ursprungsdatei schließen
wbQ.Close SaveChanges:=True
End If
Application.ScreenUpdating = True
End Sub


Gruß
Franz

Anzeige
Perfekt, Danke!
29.04.2009 10:28:14
Bernd
Hallo,
wie nicht anders erwartet wieder mal ein perfekte Lösung von Dir! Ich werde Deine Kritik mit den verbundenen Zellen zukünftig möglichst beachten, war mir so nicht geläufig, dass das für VBA die Sache deutlich verkompliziert, also sorry nochmal!
Viele Grüße
Bernd
Nochmal eine Detailfrage zum Bereich
30.04.2009 10:27:59
Bernd
Hallo Franz,
ich muss nochmal was nachfragen, die Landplage mit den verbundenen Zellen habe ich übrigens schon "eliminiert"1:
Wenn ich den Bereich Spalte 2-9 exportieren möchte UND zusätzlich noch eine Spalte DQ (Spaltennummer 119) exportieren möchte, wie ist dann der Code zu ändern? Bei der Spalte handelt es sich um eine Hilfsspalte, die ich leider ziemlich weit "außen" untergebracht habe und ich in der Wertedatei zusätzlich benötige.
Viele Grüße
Bernd
Anzeige
AW: Nochmal eine Detailfrage zum Bereich
30.04.2009 10:57:53
fcs
Hallo Bernd,
mit folgenden Anpassungen kannst du eine weiter Spalte kopieren.
Gruß
Franz

'in dem 2. Makro, dass bestimmte Zeilenbereiche kopiert
'Spaltenbreiten in Zieltabelle übertragen
SpalteZ = 0
For SpalteQ = 2 To 9
SpalteZ = SpalteZ + 1
wksZ.Columns(SpalteZ).ColumnWidth = wksQ.Columns(SpalteQ).ColumnWidth
Next
SpalteZ = SpalteZ + 1
SpalteQ = 119
wksZ.Columns(SpalteZ).ColumnWidth = wksQ.Columns(SpalteQ).ColumnWidth
'Zellformate und Werte
With wksQ
.Range(.Cells(Zeile1, 2), .Cells(Zeile2, 9)).Copy
wksZ.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksZ.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
'Daten aus Spalte DQ (119) übertragen
.Range(.Cells(Zeile1, 119), .Cells(Zeile2, 119)).Copy
wksZ.Cells(1, 9).PasteSpecial Paste:=xlPasteFormats
wksZ.Cells(1, 9).PasteSpecial Paste:=xlPasteValues
End With
'in dem 1. makro, das ganze Spalten kopiert
'Formate und Werte der Spalten 2 bis 9 von Quelle nach Ziel kopieren
With wksQ
.Range(.Columns(2), .Columns(9)).EntireColumn.Copy
wksZ.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksZ.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
'Daten aus Spalte DQ (119) übertragen
.Columns(119).Copy
wksZ.Cells(1, 9).PasteSpecial Paste:=xlPasteFormats
wksZ.Cells(1, 9).PasteSpecial Paste:=xlPasteValues
End With


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige