Problem beim Arbeitsmappe kopieren mit VBA
Betrifft: Problem beim Arbeitsmappe kopieren mit VBA
von: Cindy
Geschrieben am: 21.11.2014 11:27:47
Hallo,
ich brauche mal eure Hilfe, ich habe ein Makro, mit dem eine Datei gespeichert und in ein Dokumentenmanagementportal überführt wird. Nun mein Problem. Ich schaffe es nur ein Tabellenblatt von 4 zu übertragen. Das heißt bei der Kopie kopiert er nur ein Blatt und nicht die gesamte Mappe. Wie kann ich das beheben?
Private Sub KopieSpeichern(Dateiname As String)
Dim aktWKB As Workbook
Dim newWKB As Workbook
Dim fromWKS As Worksheet
Dim toWKS As Worksheet
Set aktWKB = ActiveWorkbook
Set fromWKS = aktWKB.Worksheets("Projektkategorisierung") '<-- hier anpassen
Set newWKB = Workbooks.Add(xlWBATWorksheet)
Set toWKS = newWKB.Worksheets(1)
toWKS.Name = fromWKS.Name
fromWKS.UsedRange.Copy
toWKS.Range("A1").PasteSpecial Paste:=xlPasteValues
toWKS.Range("A1").PasteSpecial Paste:=xlPasteFormats
'prüfen ob ein Ordner vorhanden ist und falls nicht
'fragen ob Ordner erstellt werden soll
Dim Ord As String
Dim Antwort As Integer
Ord = "C:\PKB\"
If Dir(Ord, vbDirectory) <> "" Then
MsgBox "Ordner ist schon vorhanden"
Else
Antwort = MsgBox("Der Ordner " & Ord & " ist nicht vorhanden." _
& vbNewLine _
& "soll der Ordner angelegt werden?!", vbYesNo)
If Antwort = vbYes Then
'Falls kein LW angegeben ist, erstellt die MkDir-Anweisung
'den neuen Ordner auf dem aktuellen LW.
'LW wurde aber durch "C:\PKB\" festgelegt
MkDir Ord
MsgBox "Ordner " & Ord & " angelegt"
Else
MsgBox "Es wurden keine Änderungen vorgenommen"
End If
End If
newWKB.SaveAs Filename:=Dateiname, FileFormat:=52
newWKB.Close
End Sub
Vielen Dank
Betrifft: AW: Problem beim Arbeitsmappe kopieren mit VBA
von: fcs
Geschrieben am: 21.11.2014 15:32:02
Hallo Cindy,
du kannst die Blätter in einer Schleife abarbeiten.
Gruß
Franz
Private Sub KopieSpeichern(Dateiname As String)
Dim aktWKB As Workbook
Dim newWKB As Workbook
Dim fromWKS As Worksheet, intI As Integer
Dim toWKS As Worksheet
Set aktWKB = ActiveWorkbook
With ActiveWorkbook
For intI = 1 To .Sheets.Count
Set fromWKS = aktWKB.Worksheets(intI) '<-- hier anpassen
If newWKB Is Nothing Then
Set newWKB = Workbooks.Add(xlWBATWorksheet)
Else
With newWKB
.Worksheets.Add after:=.Sheets(.Sheets.Count)
End With
End If
Set toWKS = newWKB.Worksheets(newWKB.Sheets.Count)
toWKS.Name = fromWKS.Name
fromWKS.UsedRange.Copy
toWKS.Range("A1").PasteSpecial Paste:=xlPasteValues
toWKS.Range("A1").PasteSpecial Paste:=xlPasteFormats
Next
End With
'prüfen ob ein Ordner vorhanden ist und falls nicht
'fragen ob Ordner erstellt werden soll
Dim Ord As String
Dim Antwort As Integer
Ord = "C:\PKB\"
Ord = "D:\Test\Archiv2\"
If Dir(Ord, vbDirectory) <> "" Then
MsgBox "Ordner ist schon vorhanden"
Else
Antwort = MsgBox("Der Ordner " & Ord & " ist nicht vorhanden." _
& vbNewLine _
& "soll der Ordner angelegt werden?!", vbYesNo)
If Antwort = vbYes Then
'Falls kein LW angegeben ist, erstellt die MkDir-Anweisung
'den neuen Ordner auf dem aktuellen LW.
'LW wurde aber durch "C:\PKB\" festgelegt
MkDir Ord
MsgBox "Ordner " & Ord & " angelegt"
Else
MsgBox "Es wurden keine Änderungen vorgenommen"
Exit Sub
End If
End If
newWKB.SaveAs Filename:=Ord & Dateiname, FileFormat:=52 'Anpassen, falls Ordner auch Teil _
von Dateiname ist
newWKB.Close
End Sub
 |
Betrifft: AW: Problem beim Arbeitsmappe kopieren mit VBA
von: Cindy
Geschrieben am: 24.11.2014 09:21:16
Vielen Dank es klappt.
Beiträge aus den Excel-Beispielen zum Thema "Problem beim Arbeitsmappe kopieren mit VBA "