neues Blatt und kopieren
Betrifft: neues Blatt und kopieren
von: dieter
Geschrieben am: 15.08.2014 12:49:40
Hallo all, Ich komme nicht weiter wenn es zum kopieren geht. Problem: Erstelle mir ein neues Blatt, kann dann aber nicht aus dem Blatt Umsätze_ges was rauskopieren in dem neu erstellen Blatt ab "A2".
Dim wks As Worksheet
Dim strNam As String
strNam = InputBox("Name des neuen Blatts?", "Blattname", "Umsatzwoche")
If strNam = "" Then Exit Sub
On Error Resume Next
Set wks = Worksheets(strNam)
If Err.Number <> 0 Then
Set wks = Worksheets.Add(Worksheets(1))
wks.Name = strNam
Else
MsgBox ("Blatt existiert ")
End If
On Error Resume Next
Sheets("Umsätze_Ges.").Select
Wie und wo kommt dann die Anweisung hin ?
Selection.Copy
Sheets("strNam").Select
ActiveSheet.Range("A2").Select
Selection.Insert Shift:=xlDown
Ist die überhaupt richtig?
Danke schon mal im Voraus
Mfg.
dieter
Betrifft: AW: neues Blatt und kopieren
von: Gerold
Geschrieben am: 15.08.2014 22:38:46
Hallo Dieter
Sub test()
Dim wks As Worksheet, strNam As String
strNam = InputBox("Name des neuen Blatts?", "Blattname", "Umsatzwoche")
On Error Resume Next
Set wks = Worksheets(strNam)
If Err.Number <> 0 Then
Set wks = Worksheets.Add(Worksheets(1))
wks.Name = strNam
Else
If MsgBox("Blatt ""Umsatzwoche"" existiert schon!" & vbLf & vbLf & _
"Mit dieser Seite weitermachen?", vbCritical + vbYesNo) = 7 Then
Exit Sub
End If
End If
On Error Resume Next
Worksheets("Umsätze_Ges").Range("A1:D15").Copy 'Bereich anpassen
wks.Range("A2").PasteSpecial xlPasteAll
Application.CutCopyMode = False
End Sub
Gruß Gerold
Rückmeldung wäre nett.
Betrifft: AW: neues Blatt und kopieren
von: dieter
Geschrieben am: 16.08.2014 10:55:51
Hallo Gerold,
Deine Anweisung funktioniert teilweise, weil dein vba aber immer nur den zwischen Speicher kopiert passt es nicht für mich. vllt habe ich mich falsch aus gedrückt.
Ich möchte das er mir den vorher Selektierten Bereich in Umsätze_ges nach Überprüfung ob Blatt vorhanden in dem neuen Blatt nach A2 kopiert.
Oder von mir aus anderes rum heißt, Erst Überprüfung ob Blatt vorhanden, und dann den Selektierten Bereich von Umsätze_ges kopiert in wenn dann neuem Blatt A2.
Ansonsten Danke erst mal
Gruß
Dieter
Betrifft: AW: neues Blatt und kopieren
von: JoWe
Geschrieben am: 16.08.2014 12:38:26
Hallo Gerold,
vllt. so:
Sub test()
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim mySheet As String
Dim myRng As String
mySheet = ActiveSheet.Name
myRng = Selection.Address(0, 0)
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim wks As Worksheet, strNam As String
strNam = InputBox("Name des neuen Blatts?", "Blattname", "Umsatzwoche")
On Error Resume Next
Set wks = Worksheets(strNam)
If Err.Number <> 0 Then
Set wks = Worksheets.Add(Worksheets(1))
wks.Name = strNam
Else
If MsgBox("Blatt ""Umsatzwoche"" existiert schon!" & vbLf & vbLf & _
"Mit dieser Seite weitermachen?", vbCritical + vbYesNo) = 7 Then
Exit Sub
End If
End If
On Error Resume Next
'Worksheets("Umsätze_Ges").Range("A1:D15").Copy 'Bereich anpassen
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sheets(mySheet).Range(myRng).Copy wks.Range("A2")
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Application.CutCopyMode = False
End Sub
Gruß
Jochen
Betrifft: AW: neues Blatt und kopieren
von: dieter
Geschrieben am: 16.08.2014 16:30:16
Hallo JoWe,
Erst mal danke für deine Arbeit, es funktioniert. Noch zwei Fragen, 1. könnte man dazu auch eine Abfrage einbauen in welchem Blatt Umsatzwoche er am Anfang ab "A2" es kopieren soll, da ich immer noch mal welche Umsätze in den vorhandenen Wochen kopieren muss. Oder soll ich das besser über einer Userform machen ? Frage 2, jetzt bräuchte ich nur noch das er mir das neue Blatt wenn angelegt
als 3tes von links einreiht Wie ( Move Before:=Sheets(4)). Möchte aber nicht zu viel von Dir verlangen deshalb meine Fragen dazu.
Ansonsten danke der Hilfe.
Gruß
Dieter
Betrifft: AW: neues Blatt und kopieren
von: JoWE
Geschrieben am: 17.08.2014 09:22:59
Hallo Gerold,
kein Thema:
Sub test()
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim mySheet As String
Dim myRng As String
mySheet = ActiveSheet.Name
myRng = Selection.Address(0, 0)
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim wks As Worksheet, strNam As String
strNam = InputBox("Name des neuen Blatts?", "Blattname", "Umsatzwoche")
On Error Resume Next
Set wks = Worksheets(strNam)
If Err.Number <> 0 Then
Set wks = Worksheets.Add(Worksheets(1))
wks.Name = strNam
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Worksheets(strNam).Move before:=Worksheets(4)
'oder Worksheets(strNam).Move before:=Worksheets("benannte Tabelle")
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Else
If MsgBox("Blatt ""Umsatzwoche"" existiert schon!" & vbLf & vbLf & _
"Mit dieser Seite weitermachen?", vbCritical + vbYesNo) = 7 Then
Exit Sub
End If
End If
On Error Resume Next
'Worksheets("Umsätze_Ges").Range("A1:D15").Copy 'Bereich anpassen
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sheets(mySheet).Range(myRng).Copy _
wks.Range(InputBox("Bitte Zieladresse 'Bezug' angeben:", "Abfrage Ziel", "A2"))
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Application.CutCopyMode = False
End Sub
Gruß
Jochen
Betrifft: Sorry, gemeint ist natürlich Dieter oT
von: JoWE
Geschrieben am: 17.08.2014 10:02:36
Betrifft: AW: Sorry, gemeint ist natürlich Dieter oT
von: Dieter
Geschrieben am: 17.08.2014 11:19:29
Hallo Jochen,
Erst mal danke deiner großen Mühe und Arbeit. Leider ist da ein kleiner Fehler drin, und zwar wenn ich auf abbrechen oder Kreuz geh der Inputbox erstellt er mir trotzdem ein Blatt. Des weiteren wenn er mir in dem schon vorhandenen Blatt kopiert, überschreibt er mir ab "A2" alles.
Muss da nicht ' Selection.Insert Shift:=xlDown ' rein ??
Dann nur mal die Frage bei der Anweisung Seite weitermachen?", vbCritical + vbYesNo) = 7 Then
MsgBox ' wofür steht die = 7 ??
Gruß
Dieter
Betrifft: wofür steht die = 7 ??
von: robert
Geschrieben am: 17.08.2014 17:40:52
Hi,
es gibt eine VBA-Hilfe, man kann googeln, man kann es ausprobieren usw.....
Etwas Eigeninitiative ;-)
Gruß
robert
Betrifft: AW: Sorry, gemeint ist natürlich Dieter oT
von: JoWE
Geschrieben am: 17.08.2014 20:22:40
Dieter,
die 7 ist das Ergebnis der MsgBox wenn auf 'Nein' geklickt wird. Aber sieser Teil des Makros stammt nicht von mir. Und Robert hatte darauf bereits (unwirsch) reagiert. Im Übrigen kann es sein, dass die Anforderungen an Deine Wunschlösung umfangreicher werden?! Na, egal! Hier nochmal eine Version in der die Inputbox abgebrochen werden kann.
Sub test()
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim mySheet As String
Dim myRng As String
Dim ihres As String
mySheet = ActiveSheet.Name
myRng = Selection.Address(0, 0)
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim wks As Worksheet, strNam As String
strNam = InputBox("Name des neuen Blatts?", "Blattname", "Umsatzwoche")
On Error Resume Next
Set wks = Worksheets(strNam)
If Err.Number <> 0 Then
Set wks = Worksheets.Add(Worksheets(1))
wks.Name = strNam
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Worksheets(strNam).Move before:=Worksheets(4)
'oder Worksheets(strNam).Move before:=Worksheets("benannte Tabelle")
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Else
If MsgBox("Blatt ""Umsatzwoche"" existiert schon!" & vbLf & vbLf & _
"Mit dieser Seite weitermachen?", vbCritical + vbYesNo) = 7 Then
Exit Sub
End If
End If
On Error Resume Next
'Worksheets("Umsätze_Ges").Range("A1:D15").Copy 'Bereich anpassen
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
iRes = InputBox("Bitte Zieladresse 'Bezug' angeben:", "Abfrage Ziel", "A2")
If iRes = "Falsch" Or iRes = "" Then
'Wenn die Inputbox abgebrochen wird endet das Makro abrupt!
'Das neue Tabellenblatt ist zwar bereits erstellt ist aber leer!
GoTo errBeh
Else
On Error GoTo errBeh
Sheets(mySheet).Range(myRng).Copy wks.Range(iRes)
End If
'+++++++++++++ NEU +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Application.CutCopyMode = False
Exit Sub
errBeh:
MsgBox "Ihre Eingabe enthielt keine gültigen Bezugsadresse!" _
& "Die Verarbeitung wird abgebrochen!", vbOKOnly
End Sub
Gruß
Jochen
Betrifft: unwirsch????????
von: robert
Geschrieben am: 18.08.2014 08:23:34
Hi Jochen,
so schwer kann es doch nicht sein, herauszufinden was 6 und 7 bei einer MSGBOX
bedeutet .
Was macht er mit dem gesamten Code, wenn er das nicht kann.
Außerdem gibt es Forumsregeln in denen auch die Selbsthilfe befürwortet wird.
Und mein Smylie hast Du auch nicht gesehen ?
Gruß
robert
 |
Betrifft: AW: unwirsch????????
von: Dieter
Geschrieben am: 18.08.2014 15:46:54
Hallo Jochen,
Ich danke Dir für deine mühe und deiner Hilfe soweit. Ich versuche weiter an dem Ding zu basteln.
Hallo Robert,
Entschuldige bitte das ich gefragt habe wofür die 7 steht. Ich kannte die Anweisung bisher nicht.
Und Deinen Smylie habe ich nicht gesehn,? sorry. vielmals Entschuldigung dafür.
Werde für mein nächtest Vorhaben lieber andere Boards fragen wenn ich Hilfe brauche und im netz nichts genaues finde dafür. Können ja nicht alle so schlau sein im VBA als Du.
Nagut jetzt, ich danke euch Beiden soweit der Hilfe.
Ps: Robert, weil ich das nicht kann, habe ich das jetzt über eine Userform geregelt wo es läuft wie ich gerne hätte. Ich wollte das alles nur ohne Userform Machen wenn es Dich interessiert.
Gruß
Dieter
Der Thread kann geschlossen werden
Betrifft: und zu... ;-) das ist ein Smiley owT
von: robert
Geschrieben am: 18.08.2014 17:38:34
........
Beiträge aus den Excel-Beispielen zum Thema "neues Blatt und kopieren"