Zellbereich in neue Arbeismappe

Hallo VBA Götter,
ich suche einen VBA Code, der beim Klick auf einen CommandButton, einen Zellbereich aus Arbeitsblatt 1, in eine andere, bereits bestehende Arbeitsmappe, in ein neues Arbeitsblatt, kopiert (ich hoffe, das ist verständlich). Allerdings sollen nur die Zellenformatierung und Werte, nicht die Formeln kopiert werden. Außerdem soll das neue Arbeitsblatt, die aktuelle Kalenderwoche als Namen haben.
Um den Bereich mal zu konkretisieren: B1 : BR54
Welche von meinen Ansprüchen sind möglich, welche nicht?
Ich habe bereits hier im Forum und im Archiv gesucht, aber leider nichts brauchbares gefunden bzw. weiß ich nicht wie ich die verschiedenen Bausteine, die ich gefunden habe z.B. Zellbereich kopieren, Arbeitsblatt bennenen etc., zusammenbauen kann.
Vielen Dank
Karl

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Karl,
der folgende Code kommt in ein normales Modul. Dann kannst du das Makro "KopieInAuswertungen"
leicht mit einer Schaltfläche aus der Formular-Symbolleiste verknüpfen:


Option Explicit
Sub KopieInAuswertungen()
Dim rngB As Range, strKW As String
'Hier stehen die Vorgaben - evtl. anpassen:
Const strVz As String = "F:\Exc\w-w-w\tmp\" '"C:\Test\Auswertungen\" ' "F:\Exc\w-w-w\tmp\"
Const strMN As String = "Auswertungen.xls"
Set rngB = ThisWorkbook.Worksheets("Ressourcenplan").Range("B1:BR54")
strKW = "KW" & Format(DIN_KW(Date), "00")
Workbooks.Open Filename:="F:\Exc\w-w-w\tmp\Auswertungen.xls"
If WorksheetEx(strKW) Then
If MsgBox("Das Blatt '" & strKW & "' bibt es bereits." & vbLf & vbLf & _
"Soll es überschrieben werden?", vbCritical + vbYesNo) = vbNo Then
Exit Sub
Else
Application.DisplayAlerts = False
Worksheets(strKW).Delete                        ' lösche altes Blatt
Application.DisplayAlerts = True
End If
End If
Worksheets.Add.Name = strKW
rngB.EntireColumn.Copy Cells(1, 1)        ' kopiere Spalten wg. der Formate
Range(rngB.Address).Offset(, 1 - rngB.Column) = rngB.Value ' Werte statt Formeln
Rows("55:" & Rows.Count).Delete                       ' lösche Zeilen > 54
End Sub
Public Function DIN_KW(datD As Date) As Integer
Dim tt As Integer
tt = (datD - 2) Mod 7 - 3
DIN_KW = (datD - DateSerial(Year(datD - tt), 1, tt - 6)) \ 7
End Function
Function WorksheetEx(strNam As String) As Boolean
On Error Resume Next
WorksheetEx = Worksheets(strNam).Index > 0
End Function

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellbereich in neue Arbeismappe

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread