AW: Bestimmte Bereiche exportieren
23.02.2015 00:34:19
fcs
Hallo René,
hier zwei Makros, die du ggf. noch anpassen muss bezüglich des Verzeichnises in dem die Dateien mit den exportierten Daten gespeichert werden sollen.
Gruß
Franz
Sub ExportA50_C70()
Dim wks As Worksheet
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim strPathZiel As String, strDateiname As String
Set wks = ActiveSheet 'Blatt aus dem der Bereich A50:C70 kopiert werden soll
If MsgBox("Zellbereich A50:C70 des aktivenTabellenblatts """ & wks.Name & """ exportieren?", _
_
vbQuestion + vbOKCancel, "Tabellen-Inhalt exportieren") = vbOK Then
strPathZiel = ActiveWorkbook.Path & "\" 'ggf. anpassen
strDateiname = wks.Range("B1").Text
Set wkbZiel = Application.Workbooks.Add(Template:=xlWBATWorksheet)
Set wksZiel = wkbZiel.Worksheets(1)
wks.Range("A50:C70").Copy
With wksZiel
.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
.Cells(1, 5) = "'" & strDateiname
End With
wkbZiel.SaveAs Filename:=strPathZiel & strDateiname, FileFormat:=-4143 '-4143= _
xlWorkbookNormal (xls)
wkbZiel.Close savechanges:=False
End If
End Sub
Sub Import_exported_A50_C70()
Dim wksZiel As Worksheet
Dim wkbQuelle As Workbook, wksQuelle As Worksheet
Dim varDateiname As Variant
Set wksZiel = ActiveSheet 'Blatt in das in den Bereich A10:C30 importiert werden soll
varDateiname = Application.GetOpenFilename(Filefilter:="Excel (*.xls),*.xls", _
Title:="Bitte Datei mit den zu importierenden Daten aus AC50_C70 einer Datei auswählen") _
If varDateiname False Then
Set wkbQuelle = Application.Workbooks.Open(varDateiname, ReadOnly:=True)
Set wksQuelle = wkbQuelle.Worksheets(1)
wksQuelle.Range("A1:C21").Copy
With wksZiel
.Cells(10, 1).PasteSpecial Paste:=xlPasteFormats
.Cells(10, 1).PasteSpecial Paste:=xlPasteValues
.Range("B1").Value = "'" & wksQuelle.Cells(1, 5).Text
End With
wkbQuelle.Close savechanges:=False
End If
End Sub