Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1292to1296
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
Inhaltsverzeichnis

Kopie Bereiche nur Werte

Kopie Bereiche nur Werte
27.12.2012 22:43:03
Richi
Hallo liebe Alle
nach dem ich workbook.sheets kopiert habe, hat wunderbar funktioniert mit
KopiereSheets(). Die Sheets im neuen Workbook haben sowohl Formeln, als auch verbunden Felder, diese wollte ich mit CopyWert()kopieren. Aber ich bekomme immer Laufzeitfehler 1004 bei PasteSpecial_Paste:=xlPasteValues obwohl ich mit WBaktivieren()bei den Sheets die korrekten aktiv habe.
Ich poste die 3 'Sub's
liebe Gruess
Richi
Sub KopiereSheets()
Dim awb As String 'Variable für aktives WB
awb = ActiveWorkbook.Name 'Name des aktuellen Files in Variable awb
Dim i As Integer 'sheet Nummer
i = 2 'Startwert setzen
Workbooks.Add 'neues EXCEL Objekt öffnen
For i = 2 To 6 'gilt für sheet 2-6
ThisWorkbook.Sheets(i).Copy before:=ActiveWorkbook.Sheets(i - 1)
Next i
For i = ActiveWorkbook.Sheets.Count To 1 Step -1
If WorksheetFunction.CountA(Worksheets(i).Cells) = 0 Then
Application.DisplayAlerts = False
Worksheets(i).Delete
Application.DisplayAlerts = True
Else
Workbooks(awb).Activate
CopyWert
End If
Next i
End Sub

Sub CopyWert()
i = 2 'Startwert setzen
For i = 2 To 6 'gilt für sheet 2-6
Sheets(i).Select
Dim SN As String 'Sheet Name
SN = ActiveSheet.Name
Cells.Select
Selection.Copy
WBaktivieren 'neues Excelfile aktiv setzen'
Sheets(SN).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next i
'workbooks(awb).Close SaveChanges:=True
End Sub

Sub WBaktivieren()
Dim wb As Workbook, x As String
For Each wb In Workbooks
If wb.Name  ThisWorkbook.Name Then x = wb.Name
Next wb
MsgBox "Es hat ein File mit dem Namen " & x & ". X um das Fenster zu schliessen " & vbCrLf & _
"Click OK um diese File aktiv zu setzen "
Workbooks(x).Activate
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopie Bereiche nur Werte
28.12.2012 09:15:10
Hajo_Zi
ungetestet.
Option Explicit
Dim StDatei As String
Sub KopiereSheets()
Dim awb As String 'Variable für aktives WB
awb = ActiveWorkbook.Name 'Name des aktuellen Files in Variable awb
Dim I As Integer 'sheet Nummer
I = 2 'Startwert setzen
Workbooks.Add 'neues EXCEL Objekt öffnen
StDatei = ActiveWorkbook.Name
For I = 2 To 6 'gilt für sheet 2-6
ThisWorkbook.Sheets(I).Copy before:=ActiveWorkbook.Sheets(I - 1)
Next I
For I = ActiveWorkbook.Sheets.Count To 1 Step -1
If WorksheetFunction.CountA(Worksheets(I).Cells) = 0 Then
Application.DisplayAlerts = False
Worksheets(I).Delete
Application.DisplayAlerts = True
Else
Workbooks(awb).Activate
CopyWert
End If
Next I
End Sub
Sub CopyWert()
Dim I As Integer
I = 2 'Startwert setzen
For I = 2 To 6 'gilt für sheet 2-6
Sheets(I).Select
Dim SN As String 'Sheet Name
SN = ActiveSheet.Name
Cells.Select
Selection.Copy
'WBaktivieren 'neues Excelfile aktiv setzen'
With Workbooks(StDatei).Sheets(SN)
.PasteSpecial Paste:=xlPasteValues
End With
Next I
Application.CutCopyMode = False
'workbooks(awb).Close SaveChanges:=True
End Sub

Anzeige
AW: Kopie Bereiche nur Werte
28.12.2012 12:44:29
Richi
Hallo Hajo
danke für deinen Input. Jetzt läuft das ohne Fehlermeldung durch. Jedoch hat scheint das PasteSpezial mit verbundenen Zellen ein Problem zu haben. Jedenfalls hat das erste Sheet (vielleicht liegt auch da der Fehler) in der neuen Mappe #BEZUG!
Fehler. Ob das am PasteSpezial liegt oder an der For To Schleife?
Ich habe den Code leicht angepasst unten. Falls mir da jemand noch einen Typ geben kann?
Option Explicit
Dim StDatei As String
Dim awb As String 'Variable für aktives WB
Sub KopiereSheets()
Dim awb As String 'Variable für aktives WB
awb = ActiveWorkbook.Name 'Name des aktuellen Files in Variable awb
Dim I As Integer 'sheet Nummer
I = 2 'Startwert setzen
Workbooks.Add 'neues EXCEL Objekt öffnen
StDatei = ActiveWorkbook.Name
For I = 2 To 6 'gilt für sheet 2-6
ThisWorkbook.Sheets(I).Copy before:=ActiveWorkbook.Sheets(I - 1)
Next I
For I = ActiveWorkbook.Sheets.Count To 1 Step -1
If WorksheetFunction.CountA(Worksheets(I).Cells) = 0 Then
Application.DisplayAlerts = False
Worksheets(I).Delete
Application.DisplayAlerts = True
Else
With Workbooks(awb).Sheets(I)
Dim SN As String 'Sheet Name
Sheets(I).Select
SN = ActiveSheet.Name
Cells.Select
Selection.Copy
End With
With Workbooks(StDatei).Sheets(SN)
Selection.PasteSpecial Paste:=xlPasteValues
End With
End If
Next I
End Sub

Anzeige
AW: Kopie Bereiche nur Werte
30.12.2012 14:59:28
Richi
Hallo zusammen
ich habs nicht hingekriegt mit der ersten Variante. Es hat mir immer wieder im falschen workbook kopiert, obwohl in den Variablen alles korrekt war. Ich habe es jetzt mit einer anderen Methode gelöst, indem ich die Datei unter einem neuen Namen spreichere und zuerst PasteSpecial brauche und danach die überflüssigen Sheets lösche. Viele Wege führen nach Rom..:-)
Liebe Grüsse
Richi
Sub KopiereSheets() 'via Workbooksave und weiterbearbeiten der neuen Datei
Dim Pfad As String
Dim i As Integer
Name = ActiveWorkbook.Name
Pfad = ActiveWorkbook.Path
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Pfad & "\Test.xls"
Application.DisplayAlerts = True
For i = ActiveWorkbook.Sheets.Count To 1 Step -1
Sheets(i).Select
SN = ActiveSheet.Name
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Next i
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(Array(1, 7, 8, 9, 10, 11)).Delete 'nicht benötigte Sheets zumversenden
Application.DisplayAlerts = True
Application.Dialogs(xlDialogSendMail).Show arg1:="test@test.ch", arg2:="Test Request" & " " &  _
Date
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige