Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
692to696
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
692to696
692to696
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kopieren in anderes Tab

Kopieren in anderes Tab
09.11.2005 17:45:12
angela
Hallo
habe ein Makro, das mir die Daten in ein bestimmtes Tab kopiert, A6:R56.
Nun möchte ich gern, das er mir die neuen Daten daunter schreibt also in A58:R111 usw. Geht so etwa mit VBA?
Könnt Ihr mir vielleicht helfen?
Mfg Angela
Sub Datenübertrag()
'Daten kopieren
Range("A6:R56").Select
Selection.Copy
'Arbeitsblatt auswählen
Select Case [A30]
Case Is = 1
Sheets("1996").Select
Case Is = 2
Sheets("1997").Select
Case Is = 3
Sheets("1998").Select
Case Is = 4
Sheets("1999").Select
Case Is = 5
Sheets("2000").Select
Case Is = 6
Sheets("2001").Select
Case Is = 7
Sheets("2002").Select
Case Is = 8
Sheets("2003").Select
Case Is = 9
Sheets("2004").Select
Case Is = 10
Sheets("2005").Select
Case Is = 11
Sheets("2006").Select
Case Is = 12
Sheets("2007").Select
End Select
'Datum suchen
[c6].Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Select Case [A6]
Case Is = [A6]
[A6].Select
End Select

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren in anderes Tab
09.11.2005 17:49:35
Ralph
Hallo Angela,
was willst Du machen?
Woher sind die alten Daten, woher die neuen ?
Gruß
Ralph
AW: Kopieren in anderes Tab
09.11.2005 17:58:43
ANGELA
Hallo Ralph,
die daten stehen in ein Tab "Datenerfassung",. Nachdem das Formular ausgefüllt ist soll es kopiert werden in ein anderes Tab 1996 bis 2007 das ich vorher mir aus ein Steuerelement mit Zellverknüpfung hole.
Ich hoffe ich habe es richtig erklärt.
Mfg. Angela
AW: Kopieren in anderes Tab
09.11.2005 18:15:13
Ralph
Hallo Angela,
wenn du in deinem Makro anstelle der Zeile
[c6].Select
folgendes einträgst, dann sollte es funktionieren (wenn ich's richtig verstanden habe)
ActiveSheet.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1,1).Select
Gruß
Ralph
Ach ja, wenn's nich klappt, muss jetzt noch ne Stunde nach Hause fahren, meld mich dann vielleicht nochmal, wenn nicht dann morgen.
Anzeige
AW: Kopieren in anderes Tab
09.11.2005 18:10:34
Andi
Hi Angela,
ich hoffe mal, ich hab das Ziel der Übung richtig verstanden:
- es gibt ein Ausgangstabellenblatt mit Daten im Bereich A6:R56
- nach Start des Makros sollen diese Daten kopiert werden, und zwar abhängig vom Wert in A30 in eine Tabelle deren Name sich errechnen lässt aus 1995 + Wert in A30
- dort sollen die Daten immer untereinander geschrieben werden, also beim ersten Mal in A6:R56, beim zweiten Mal in A58:R108 (ich jedenfalls komme nicht auf R111)
wenn das sowieit stimmt, dann sollte folgendes funzen:

Sub test()
Dim letzte_zeile As Integer
Range("A6:R56").Copy
With Sheets(CStr(1995 + Range("A30").Value))
letzte_zeile = .Cells(65536, 1).End(xlUp).Row
Select Case letzte_zeile
Case Is < 56
.Range("A6:R56").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Case Else
.Range("A" & letzte_zeile + 2 & ":R" & letzte_zeile + 52).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
End Select
End With
Application.CutCopyMode = False
End Sub

Schönen Gruß,
Andi
Anzeige
AW: Kopieren in anderes Tab
09.11.2005 18:46:07
angela
Hallo Andi
vielen dank für Deine schnelle Antwort.
mußte leider Die Jahressheets 1995 - 2007 nach Namen machen und eben statt A30 U22 genommen, sonst habe ich nichts verändert. Leider stoppt er in der 3 Zeile(With Sheets(CStr(Meyer + Range("U22").Value))
Vielleicht ist es auch möglich, das das Steuerelement nur auf dem Namen zugreift das im Formular steht, dort würde dann nur immer in U22 eine 1 stehen. die anderen Tabs haben den Namen Meyer usw.
Vielleicht kannst Du mir noch eine kleine Hilfe geben.
Mfg. Angela

Sub test()
Dim letzte_zeile As Integer
Range("A6:R56").Copy
With Sheets(CStr(Meyer + Range("U22").Value))
letzte_zeile = .Cells(65536, 1).End(xlUp).Row
Select Case letzte_zeile
Case Is < 56
.Range("A6:R56").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Case Else
.Range("A" & letzte_zeile + 2 & ":R" & letzte_zeile + 52).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
End Select
End With
Application.CutCopyMode = False
End Sub

Anzeige
AW: ergänzung
09.11.2005 18:59:36
angela
hallo Andi
habe noch vergessen, dann wäre statt A30, I7:P7 der Wert.
liebe grüße Angela
AW: ergänzung
09.11.2005 21:29:29
angela
Hallo nochmal
habe folgenden Code gefunden, der auch ein neues Tab erstellt.
Was er leider nicht kann ist, er kann die Daten leider nicht unter den vorhandenen Daten kopieren mit 2 Zellen abstand, unddie ursprüngliche Formatierung behalten.
vielleicht hat doch noch einer ein Tipp.
Gruß Angela
Sub DatenUebertragenNeuTab()
Dim wks As Worksheet, neu As Worksheet
Dim strFrage As String
Dim iCol As Integer, iRow As Integer, n As Integer
Set wks = Sheets("Std-Zettel")
If SheetExist(wks.[I7].Text) Then
Set neu = Sheets(wks.[I7].Text)
strFrage = MsgBox("Eine Tabelle mit dem Namen """ & wks.[I7].Text & _
""" ist bereits vorhanden!" & Space(10) & vbLf & vbLf & _
"Soll die Tabelle aktualisiert werden?", vbYesNo + vbInformation, "Hinweis")
If strFrage = vbNo Then Exit Sub
Else
Set neu = Worksheets.Add(after:=Sheets(Sheets.Count))
neu.Name = wks.[I7].Text
End If
With neu
.Range("$A$6:$R$56").ClearContents
.[I7] = wks.[I7]
.Range("$A$6:$R$56").Copy
'For iRow = 0 To 45 Step 15
' .Range(.Cells(5 + iRow, 2), .Cells(15 + iRow, 2)).Value = _
wks.Range("E" & 5 + iRow + n & ":E" & 15 + iRow + n).Value
' .Range(.Cells(5 + iRow, 3), .Cells(15 + iRow, 7)).Value = _
wks.Range("J" & 5 + iRow + n & ":N" & 15 + iRow + n).Value
' .Range(.Cells(5 + iRow, 10), .Cells(15 + iRow, 10)).Value = _
wks.Range("E" & 16 + iRow + n & ":E" & 26 + iRow + n).Value
' .Range(.Cells(5 + iRow, 11), .Cells(15 + iRow, 15)).Value = _
wks.Range("J" & 16 + iRow + n & ":N" & 26 + iRow + n).Value
n = n + 7
' Next
End With
End Sub

Private Function SheetExist(ByVal sheetName As String, Optional WbName As String) As Boolean
Dim wks As Worksheet
On Error GoTo ERRORHANDLER
If WbName = "" Then WbName = ThisWorkbook.Name
For Each wks In Workbooks(WbName).Worksheets
If wks.Name = sheetName Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function

Anzeige
AW: ergänzung
09.11.2005 23:15:27
Andi
Hi Angela,
sorry, war ne Weile nicht am Rechner und bin eben erst heimgekommen;
vielleicht liegt's an der Uhrzeit oder daran, dass es da wo ich grad herkomme Bier gab :-), aber ich kann mir grad den Aufbau Deiner Mappe ned so recht vorstellen; kannst Du das Ding mal hochladen und kurz beschreiben, was genau passieren soll?
Schönen Gruß,
Andi
AW: ergänzung
10.11.2005 17:15:56
angela
Hallo Andy
bin auch gerade zu Hause, nett das Du Dich nochmal gemeldet hast.
Die datei habe ich angehängt, dort sind weitere Erklärungen.
https://www.herber.de/bbs/user/28285.xls
Mit lieben Gruß Angela
Anzeige
AW: ergänzung
10.11.2005 17:26:58
Andi
Hi,
jetz hast Du mich leider erst kurz bevor ich den Rechner mal wieder runterfahre erwischt...
Ich guck mir das auf jeden Fall nochmal an, aber ich kann leider nicht versprechen, dass ich da vor dem Wochenende noch dazu komme.
Ich hoffe, das reicht.
Schönen Abend noch,
Andi
AW: ergänzung
10.11.2005 17:32:03
angela
hallo Andy
Danke das Du Dich so schnell gemeldest hast.
Fahre Morgen für 2 Tage weg, bin dann erst am Sonntagabend wieder da.
Würde mich freuen, wenn Du Dich nochmals meldest.
Lieben Gruß Angela
mach ich...
10.11.2005 17:44:15
Andi
... ggf. in nem neuen thread, falls der hier dann schon ins Archiv gerutscht sein sollte.
Schönen Gruß,
Andi
Anzeige
Hallo Andy!?
13.11.2005 18:21:08
Angela
Hallo Andy
bin wieder zu Hause. Wäre nett wenn Du Dich nochmals Melden magst.
Liebe Grüße Angela

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige