Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

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 "