Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Sheets kopieren und in neue Datei

VBA: Sheets kopieren und in neue Datei
30.06.2016 11:19:23
jam

Hallo zusammen,
ich habe folgendes Anliegen. Mit dem u.g. Code kopiere ich zwei Tabellenblätter in eine neue Datei. Soweit OK. Ich möchte aber eigentlich aus dem Sheet "Altdaten" nur die Spalten A-C, F,J kopieren und in dem zweiten Blatt " Neudaten" nur die vorhandene Pivot per snapshot kopieren und in die neue Datei einfügen ( via ExcelCam?)
Ich weiß aber nicht, wie der Code dafür entsprechend umgebaut werden muss.
Könnt ihr mir bitte helfen?


Sub Report_Daten()
Dim strDateiname As String
ChDir "Q:\Test1\Test2\"
strDateiname = Application.GetSaveAsFilename _
("Test_Report_" & Date & ".xlsx", "Microsoft Excel-Dateien (*.xlsx),*.xlsx")
If TypeName(strDateiname) = "String" Then
Worksheets(Array("Altdaten", "Neudaten")).Copy
With ActiveSheet.UsedRange
.Value = .Value
End With
ActiveWorkbook.SaveAs strDateiname
ActiveWorkbook.Close
MsgBox "Fertig! Datei gespeichert unter:" & vbLf & vbLf & strDateiname, vbOKOnly +  _
vbInformation, "Datei wurde gespeichert"
End If
End Sub

vielen Dank schon mal an euch

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Sheets kopieren und in neue Datei
01.07.2016 05:24:33
fcs
Hallo jam,
die Pivot-Daten der 2. Tabelle solltest du ebenfall in einen Bereich umwandeln, der nur noch die Werte des Pivotberichts enthält. Die Photo-Funktion hat ihre grenzen.
Gruß
Franz
Sub Report_Daten()
Dim strDateiname As Variant
Dim wkbNeu As Workbook, wkbAktiv As Workbook
Dim wksNeu As Worksheet
Dim strRange As String
'     ChDir "Q:\Test1\Test2\"
ChDir "C:\Users\Public\Test\Archiv\"
strDateiname = Application.GetSaveAsFilename _
("Test_Report_" & Date & ".xlsx", "Microsoft Excel-Dateien (*.xlsx),*.xlsx")
If strDateiname <> False Then
Set wkbAktiv = ActiveWorkbook
Worksheets(Array("Altdaten", "Neudaten")).Copy
Set wkbNeu = ActiveWorkbook
With wkbNeu.Sheets("Altdaten").UsedRange
.Value = .Value
'nicht mehr benötigte Spalten löschen
If .Column + .Columns.Count - 1 > 10 Then 'Spalte J
.Range(.Columns(11), .Columns(.Column + .Columns.Count - 1)).Delete
End If
.Range(.Columns(7), .Columns(9)).Delete
.Range(.Columns(4), .Columns(5)).Delete
End With
Set wksNeu = wkbNeu.Sheets("Neudaten")
With wksNeu
strRange = .UsedRange.Address
.UsedRange.ClearContents
wkbAktiv.Sheets("Neudaten").UsedRange.Copy
.Range(strRange).PasteSpecial (xlPasteFormats)
.Range(strRange).PasteSpecial (xlPasteValues)
End With
ActiveWorkbook.SaveAs strDateiname, FileFormat:=51 '51 = xlOpenXMLWorkbook
ActiveWorkbook.Close
MsgBox "Fertig! Datei gespeichert unter:" & vbLf & vbLf & strDateiname, vbOKOnly + _
vbInformation, "Datei wurde gespeichert"
End If
End Sub

Anzeige
AW: VBA: Sheets kopieren und in neue Datei
02.07.2016 13:49:57
jam
Hallo Franz,
klasse, funktioniert super! Ein dickes Dankeschön für deine Hilfe.
Gruß
jam

356 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige