Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
536to540
536to540
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten mittels VBA in neue Tabelle kopieren

Daten mittels VBA in neue Tabelle kopieren
21.12.2004 20:15:18
Fritz
Hallo VBA-Experten,
ich möchte Daten aus der Tabelle1 (Quelltabelle) in die Tabelle2 (Zieltabelle)übertragen (kopieren).
So wie ich mir das vorstelle geht das wohl nur mit VBA, deshalb hoffe ich auf Hilfen hier im Forum.
Ich habe nachfolgend die Struktur der Zieltabelle (Tabelle 2) dargestellt. Die eingerahmten Zellen sind die Zellen, die mit den entsprechenden Daten aus der Quelltabelle (Tabelle1) gefüllt werden sollen. Die Angaben in den Zellen der Tabelle2 verweisen auf die Herkunft der Daten in Tabelle1 (jeweils die Zellbezeichnung der Quelltabelle ist angegeben).
Tabelle2
 ABCDEFGHIJKLMNO
1               
2  C2            
3               
4               
5 E5J5K6L6M6N6  E16J16K16L16M16N16
6 E6J5J6J7J8J9  E17J17K17L17M17N17
7 E7J5J6J7J8J9  E18J18K18L18M18N18
8 E8J5J6J7J8J9  E19J19K19L19M19N19
9 E9J5J6J7J8J9  E20J20K20L20M20N20
10 E10J5J6J7J8J9  E21J21K21L21M21N21
11 E11J5J6J7J8J9  E22J22K22L22M22N22
12 E12J5J6J7J8J9  E23J23K23L23M23N23
13 E13J5J6J7J8J9  E24J24K24L24M24N24
14 E14J5J6J7J8J9  E25J25K25L25M25N25
15 E15J5J6J7J8J9  E26J26K26L26M26N26
16               
17               
18               
19               
20 E27J26K27L27M27N27  E38J38K38L38M38N38
21 E28J60K28L28M28N28  E39J39K39L39M39N39
22 E29J28K29L29M29N29  E40J40K40L40M40N40
23 E30J29K30L30M30N30  E41J41K41L41M41N41
24 E31J30K31L31M31N31  E42J42K42L42M42N42
25 E32J31K32L32M32N32  E43J43K43L43M43N43
26 E33J32K33L33M33N33  E44J44K44L44M44N44
27 E34J33K34L34M34N34  E45J45K45L45M45N45
28 E35J34K35L35M35N35  E46J46K46L46M46N46
29 E36J35K36L36M36N36  E47J47K47L47M47N47
30 E37J36K37L37M37N37  E48J48K48L48M48N48
31               
32               
33               
34               
35 E49J26K49L49M49N49  E60J60K60L60M60N60
36 E50J27K50L50M50N50  E61J61K61L61M61N61
37 E51J28K51L51M51N51  E62J62K62L62M62N62
38 E52J29K52L52M52N52  E63J63K63L63M63N63
39 E53J30K53L53M53N53  E64J64K64L64M64N64
40 E54J31K54L54M54N54  E65J65K65L65M65N65
41 E55J32K55L55M55N55  E66J66K66L66M66N66
42 E56J33K56L56M56N56  E67J67K67L67M67N67
43 E57J34K57L57M57N57  E68J68K68L68M68N68
44 E58J35K58L58M58N58  E69J69K69L69M69N69
45 E59J36K59L59M59N59  E70J70K70L70M70N70
46               
47               
48               
49               
50 E71J26K71L71M71N71  E82J82K82L82M82N82
51 E72J27K72L72M72N72  E83J83K83L83M83N83
52 E73J28K73L73M73N73  E84J84K84L84M84N84
53 E74J29K74L74M74N74  E85J85K85L85M85N85
54 E75J30K75L75M75N75  E86J86K86L86M86N86
55 E76J31K76L76M76N76  E87J87K87L87M87N87
56 E77J32K77L77M77N77  E88J88K88L88M88N88
57 E78J33K78L78M78N78  E89J89K89L89M89N89
58 E79J34K79L79M79N79  E90J90K90L90M90N90
59 E80J35K80L80M80N80  E91J91K91L91M91N91
60 E81J36K81L81M81N81  E92J92K92L92M92N92
61               
 
Diagramm - Grafik - Excel Tabellen einfach im Web darstellen    Excel Jeanie HTML  3.0    Download  
Anschließend sollte das Makro eine Kopie der Tabelle2 erstellen und als Name die Angabe in der Zelle C2 verwenden. Sollte eine Tabelle unter diesem Namen bereits existieren, sollte ein Hinweis erscheinen mit den folgenden Möglichkeiten: Diese bestehende Tabelle entweder zu löschen und danach die Kopie zu erstellen oder auf die Kopie zu verzichten.
Für eure Hilfen bereits jetzt besten Dank.
Gruß
Fritz

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten mittels VBA in neue Tabelle kopieren
PeterW
Hallo Fritz,
das kannst du alles mit dem Rekorder lösen. Schau dir das mal als Ansatz an, der natürlich noch erweitert werden muss:
Sub BereichKopieren() Dim iCount As Integer Dim bolDa As Boolean With Sheets("Tabelle2") Range("E5:N15, E27:N37, E71:N81").Copy .Range("B5") .Columns("C:F").Delete Range("E16:N26, E38:N48, E82:N92").Copy .Range("J5") .Columns("K:N").Delete .Rows("16:19").Insert For iCount = 1 To Worksheets.Count If Worksheets(iCount).Name = .Range("C2") Then bolDa = True Exit For End If Next If bolDa Then 'Entscheidung, was gemacht werden soll Else 'Kopie anlegen End If End With End Sub
Gruß
Peter
Anzeige
AW: Daten mittels VBA in neue Tabelle kopieren
Fritz
Hallo Peter,
danke für die Hilfe.
Ich werds probieren. Meine VBA-Kenntnisse sind jedoch äußerst mies. Ich hoffe nur, dass ich das hinkrieg. Heute werd ichs auf keinen Fall mehr schaffen. Melde mich später ggf. noch einmal hier.
Gruß
Fritz
Korrektur!
Fritz
Hallo Forumsteilnehmer,
habe mich vergeblich an der Umsetzung von Peters Vorschlag versucht.
Ich habe dabei jedoch auch festgestellt, dass sich in meiner Zuordnung (Hinweis auf zu kopierende Zellen der Quelltabelle) in der Zieltabelle etliche Fehler eingeschlichen haben, die ich nachfolgend korrigiert habe.
Tabelle2
 ABCDEFGHIJKLMNO
2  C2            
3               
4               
5 E5J5K5L5M5N5  E16J16K16L16M16N16
6 E6J6K6L6M6N6  E17J17K17L17M17N17
7 E7J7K7L7M7N7  E18J18K18L18M18N18
8 E8J8K8L8M8N8  E19J19K19L19M19N19
9 E9J9K9L9M9N9  E20J20K20L20M20N20
10 E10J10K10L10M10N10  E21J21K21L21M21N21
11 E11J11K11L11M11N11  E22J22K22L22M22N22
12 E12J12K12L12M12N12  E23J23K23L23M23N23
13 E13J13K13L13M13N13  E24J24K24L24M24N24
14 E14J14K14L14M14N14  E25J25K25L25M25N25
15 E15J15K15L15M15N15  E26J26K26L26M26N26
16               
17               
18               
19               
20 E27J27K27L27M27N27  E38J38K38L38M38N38
21 E28J28K28L28M28N28  E39J39K39L39M39N39
22 E29J29K29L29M29N29  E40J40K40L40M40N40
23 E30J30K30L30M30N30  E41J41K41L41M41N41
24 E31J31K31L31M31N31  E42J42K42L42M42N42
25 E32J32K32L32M32N32  E43J43K43L43M43N43
26 E33J33K33L33M33N33  E44J44K44L44M44N44
27 E34J34K34L34M34N34  E45J45K45L45M45N45
28 E35J35K35L35M35N35  E46J46K46L46M46N46
29 E36J36K36L36M36N36  E47J47K47L47M47N47
30 E37J37K37L37M37N37  E48J48K48L48M48N48
31               
32               
33               
34               
35 E49J49K49L49M49N49  E60J60K60L60M60N60
36 E50J50K50L50M50N50  E61J61K61L61M61N61
37 E51J51K51L51M51N51  E62J62K62L62M62N62
38 E52J52K52L52M52N52  E63J63K63L63M63N63
39 E53J53K53L53M53N53  E64J64K64L64M64N64
40 E54J54K54L54M54N54  E65J65K65L65M65N65
41 E55J55K55L55M55N55  E66J66K66L66M66N66
42 E56J56K56L56M56N56  E67J67K67L67M67N67
43 E57J57K57L57M57N57  E68J68K68L68M68N68
44 E58J58K58L58M58N58  E69J69K69L69M69N69
45 E59J59K59L59M59N59  E70J70K70L70M70N70
46               
47               
48               
49               
50 E71J71K71L71M71N71  E82J82K82L82M82N82
51 E72J72K72L72M72N72  E83J83K83L83M83N83
52 E73J73K73L73M73N73  E84J84K84L84M84N84
53 E74J74K74L74M74N74  E85J85K85L85M85N85
54 E75J75K75L75M75N75  E86J86K86L86M86N86
55 E76J76K76L76M76N76  E87J87K87L87M87N87
56 E77J77K77L77M77N77  E88J88K88L88M88N88
57 E78J78K78L78M78N78  E89J89K89L89M89N89
58 E79J79K79L79M79N79  E90J90K90L90M90N90
59 E80J80K80L80M80N80  E91J91K91L91M91N91
60 E81J81K81L81M81N81  E92J92K92L92M92N92
 
Diagramm - Grafik - Excel Tabellen einfach im Web darstellen    Excel Jeanie HTML  3.0    Download  
Bin auf weitere Hilfen angewiesen und bedanke mich bereits jetzt für jegliche Unterstützung bei der Umsetzung meines Vorhabens.
Gruß
Fritz
Anzeige
AW: Korrektur!
21.12.2004 22:30:44
Josef
Hallo Fritz!
Wieder ich;-))
Probier mal:
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("Tabelle1") If SheetExist(wks.[C2].Text) Then Set neu = Sheets(wks.[C2].Text) strFrage = MsgBox("Eine Tabelle mit dem Namen """ & wks.[C2].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.[C2].Text End If With neu .Range("$B$5:$G$15,$J$5:$O$15,$J$20:$O$30,$B$20:$G$30," & _ "$B$35:$G$45,$J$35:$O$45,$B$50:$G$60,$J$50:$O$60").ClearContents .[C2] = wks.[C2] 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
Gruß Sepp
Anzeige
AW: Korrektur! - Freue mich!
Fritz
Guten Morgen Sepp,
ich freue mich immer über Deine Hilfen.
Ich werde heute nachmittag testen und melde mich dann ggf. noch einmal.
vielen Dank und einen schönen Tag
Fritz
Nach Test!
Fritz
Hallo Sepp,
das Makro funktioniert - bis auf die nachfolgende Ausnahme - wie ich mir das vorgestellt habe:
Die Tabelle2 existiert bereits in meiner Arbeitsmappe. Sie enthält auch bereits Formatierungen und einige Formeln. Aus diesem Grund wäre es wichtig, wenn diese - als Blatt ausgeblendete - Tabelle2 zunächst kopiert wird (Kopie eingeblendet), schließlich umbenannt wird (dabei Prüfung, ob eine Tabelle mit dieser Bezeichnung bereits vorhanden usw.) und danach die Daten aus Tabelle1 in diese Tabelle kopiert werden.
Wenn es klappt, wäre schön ansonsten auch für die bereits geleistete Hilfe vielen Dank!
Gruß
Fritz
Anzeige
AW: Nach Test!
22.12.2004 17:55:34
Josef
Hallo Fritz!
Daran soll's nicht scheitern.

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("Tabelle1")
If SheetExist(wks.[C2].Text) Then
Set neu = Sheets(wks.[C2].Text)
strFrage = MsgBox("Eine Tabelle mit dem Namen """ & wks.[C2].Text & _
""" ist bereits vorhanden!" & Space(10) & vbLf & vbLf & _
"Soll die Tabelle aktualisiert werden?", vbYesNo + vbInformation, "Hinweis")
If strFrage = vbNo Then Exit Sub
Else
Worksheets("Tabelle2").Copy After:=Sheets(Sheets.Count) 'Name der Vorlagentabelle anpassen!
Set neu = Sheets(Sheets.Count)
neu.Name = wks.[C2].Text
neu.Visible = xlSheetVisible
End If
With neu
.Range("$B$5:$G$15,$J$5:$O$15,$J$20:$O$30,$B$20:$G$30," & _
"$B$35:$G$45,$J$35:$O$45,$B$50:$G$60,$J$50:$O$60").ClearContents
.[C2] = wks.[C2]
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

Gruß Sepp
Anzeige
Ein Meister seines Fachs!
Fritz
Hallo Sepp,
hervorragend und ganz in meinem Sinne gelöst!
Auch wenn ich mich wiederhole:
Was in diesem Forum - insbesondere von Dir - uns Forumsteilnehmer an Unterstützung geboten wird sucht seinesgleichen! Worte sind nunmal (im Moment) die einzige Möglichkeit, Dir und allen Helfern meinen Respekt und Dank auszusprechen!
Gruß
Fritz
@Sepp: Auch ein guter Lehrmeister!
Fritz
Hallo Sepp,
nur zur Information. Es ist mir tatsächlich gelungen, deinen Code (wenn auch nur ansatzweise) zu "lesen", denn ich habe es geschafft, eine zusätzliche Variante (allerdings wohl relativ einfach) einzubauen. Das ganze hat tatsächlich wie gewünscht funktioniert. Ein erster kleiner Schritt.
Ich bin mir jedoch auch bewußt, dass ich noch lange und vieles lernen muss. Ebenso weiß ich, dass ich ein solches Format wie mein "Lehrer" in Sachen VBA nicht mehr erreichen werde.
Ein bischen stolz auf das erste Erfolgserlebnis bin ich allerdings schon und ich hatte eben das Bedürfnis, den Lehrmeister davon in Kenntnis zu setzen.
Gruß
Fritz
Anzeige
AW: @Sepp: Auch ein guter Lehrmeister!
22.12.2004 20:41:05
Josef
Hallo Fritz!
Ich finde es übertrieben wenn du mich "Meister" nennst!
Wahre Meister sind andere hier im Forum, deren Namen ich aber nicht
nennen will, weil ich bestimmt einige übergehen würde.
Ich beschäftige mich mit Excel und VBA nur aus "spass an der freud" und
versuche mit meinem Wissen anderen zu helfen.
Es freud mich zu hören, das du versuchst den Code zu verstehen.
Ich glaube im Namen aller Helfer hier im Forum sagen zu düfren, dass
es nichts frustrierenderes gibt, als Hifesuchende die nicht mitdenken
wollen und dann vieleicht auch noch meckern, wenn, oft durch mangelnde
Angaben, der Code oder die Formel nicht auf Anhieb läuft.
Schade finde ich oft auch, dass nach einem gelösten Problem, der Hilfesuchende
es nicht mal der Mühe wert findet, eine kurze Info zu geben ob er mit
der Lösung klar kommt oder nicht.
Das Forum lebt vom Geben und Nehmen gleichermassen.
Genug der Philosophie, bis dann,
Sepp
Anzeige
AW: @Sepp: Auch ein guter Lehrmeister!
Fritz
Hallo Sepp,
nur noch zwei Anmerkungen:
Sicherlich kann ich (als VBA-Unkundiger) Unterschiede der Hilfen (Code) einzelner schwer beurteilen. Aber subjektiv aus meiner Sicht und meinen Erfahrungen mit den Hilfen bleibst Du für mich ein Könner. Das sind echte Hilfen, die ich hier erhalten habe und das will ich in irgendeiner Form zum Ausdruck bringen. Freu Dich einfach über das Lob!
Und Dankbarkeit - und die äußert auch in einer Rückmeldung des Hilfesuchenden - ist das mindeste was Ihr Helfer erwarten dürft, da sind wir einer Meinung.
Schönen Abend Dir und allen fleißigen Helfern
Gruß
Fritz
Anzeige

340 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige