Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1376to1380
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
neues Blatt und kopieren
15.08.2014 12:49:40
dieter
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

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: neues Blatt und kopieren
15.08.2014 22:38:46
Gerold
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.

Anzeige
AW: neues Blatt und kopieren
16.08.2014 10:55:51
dieter
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

AW: neues Blatt und kopieren
16.08.2014 12:38:26
JoWe
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

Anzeige
AW: neues Blatt und kopieren
16.08.2014 16:30:16
dieter
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

Anzeige
AW: neues Blatt und kopieren
17.08.2014 09:22:59
JoWE
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

Anzeige
Sorry, gemeint ist natürlich Dieter oT
17.08.2014 10:02:36
JoWE

AW: Sorry, gemeint ist natürlich Dieter oT
17.08.2014 11:19:29
Dieter
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

wofür steht die = 7 ?
17.08.2014 17:40:52
robert
Hi,
es gibt eine VBA-Hilfe, man kann googeln, man kann es ausprobieren usw.....
Etwas Eigeninitiative ;-)
Gruß
robert

Anzeige
AW: Sorry, gemeint ist natürlich Dieter oT
17.08.2014 20:22:40
JoWE
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

Anzeige
unwirsch?
18.08.2014 08:23:34
robert
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

AW: unwirsch?
18.08.2014 15:46:54
Dieter
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

Anzeige
und zu... ;-) das ist ein Smiley owT
18.08.2014 17:38:34
robert
........

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige