Anzeige
Archiv - Navigation
1288to1292
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
Inhaltsverzeichnis

VBA kopieren und zeilen einfügen

VBA kopieren und zeilen einfügen
17.12.2012 14:53:15
dirk0011
Hallo zusammen,
habe ein ganz kleines Problem. Mit dem Button Werte Kopieren in dem Reiter "zusammenfassung" kopiert mir das Script wunderbar jeden neuen Eintrag von den dahinter liegenden Reitern. Jetzt kommt die Frage dazu.
Ich möchte gerne eigentlich immer die in grau markierten Überschriften behalten ( Zeile( 2, 57, 60, 62 aktuell). Dies bedeutet, wenn bei zB dem Reiter "hurst" etwas neues dazu kommt, soll das script dort eine zeile hinzufügen und die Daten dort eintragen. Aktuell löscht das Script alles und kopiert aus allen bereichen etwas hinein. Könnt ihr mir damit helfen?
Gruss
Dirk
https://www.herber.de/bbs/user/83034.xlsm

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA kopieren und zeilen einfügen
18.12.2012 06:43:24
Matze,Matthias
Hallo dirk0011,
Option Explicit
Sub WerteRein()
Dim i As Integer
Dim lRow As Long
Dim lRow2 As Long
With Sheets(1)
Cells.Delete
End With
For i = 2 To ActiveWorkbook.Sheets.Count
With Sheets(i)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(lRow, 10)).Copy
lRow2 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(1).Range("A" & lRow2).PasteSpecial
Application.CutCopyMode = False
End With
Next i
End Sub
Matze

kleiner Zusatz
18.12.2012 06:58:31
Matze,Matthias
damit der Bildschirm nicht so flackert,...
Sub WerteRein()
Dim i As Integer
Dim lRow As Long
Dim lRow2 As Long
Application.ScreenUpdating = False
With Sheets(1)
Cells.Delete
End With
For i = 2 To ActiveWorkbook.Sheets.Count
With Sheets(i)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(lRow, 10)).Copy
lRow2 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(1).Range("A" & lRow2).PasteSpecial
Application.CutCopyMode = False
End With
Next i
Application.ScreenUpdating = True
Sheets(1).Range("A1").Select
End Sub
Matze

Anzeige
AW: kleiner Zusatz
18.12.2012 08:28:41
dirk0011
Guten Morgen.
kleine Bitte kannst du das in mein Excel Sheet einbauen und mir senden..bin echt ein ziemlicher Laie was das betrifft

AW: kleiner Zusatz
18.12.2012 08:47:34
dirk0011
ich habe dein quellcode jetzt mal in das script kopiert..aber irgendwie passiert da nichts..bei mir auf jeden fall..wenn ich in den anderen blätter etwas hinzufüge, wird das nicht in der zusammenfassung hinzugefügt..kann das sein?

AW: kleiner Zusatz
18.12.2012 08:53:50
dirk0011
huhu...
so deine funktion funktionert fast perfekt..er lässt aber immer den letzen eintrag unberührt, der neu hinzu kommmt und kopiert diesen nicht rüber

letzter Eintrag
18.12.2012 09:04:21
Klaus
Hallo Dirk,
den letzen eintrag unberührt
Kann eigentlich nicht sein. Der Codeteil
              lRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(lRow, 10)).Copy

nimmt definitiv den gesamten Bereich mit. Es sei denn, Spalte A ist nicht bis zur letzten Zeile gefüllt, aber IIRC war das in deiner Musterdatei der Fall.
Lädst du bitte mal deine Tabelle im IST-Zustand hoch? Oder Antwortest, dass Spalte A nicht gefüllt war (denn dann ist es einfach).
Grüße,
Klaus M.vdT.

Anzeige
AW: letzter Eintrag
18.12.2012 09:07:03
dirk0011
Habe hier nochmal die Dateie mit deinem Code angehäng..im letzten Reiter Beeckmann funktioniert es genau richtig..in dem ersten Reiter Oertel zum beispiel nicht
https://www.herber.de/bbs/user/83049.xlsm

AW: letzter Eintrag
18.12.2012 09:37:46
Klaus

Option Explicit
Sub WerteRein()
Dim i As Integer
Dim lRow As Long
Dim lRow2 As Long
Application.ScreenUpdating = False
With Sheets(1)
Cells.Delete
End With
For i = 2 To ActiveWorkbook.Sheets.Count
With Sheets(i)
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(lRow, 10)).Copy
lRow2 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets(1).Range("A" & lRow2).PasteSpecial
Application.CutCopyMode = False
End With
Next i
Application.ScreenUpdating = True
Sheets(1).Range("A1").Select
End Sub
Die Überschriften sollen jedesmal mit kopiert werden? Wenn nicht, ändere
.Range(.Cells(1, 1), .Cells(lRow, 10)).Copy in
.Range(.Cells(2, 1), .Cells(lRow, 10)).Copy
Grüße,
Klaus M.vdT.

Anzeige
AW: letzter Eintrag
18.12.2012 09:46:41
dirk0011
super...du bist super!!!

Danke für die Rückmeldung! owT
18.12.2012 09:47:27
Klaus
.

einen noch (wichtig!!)
18.12.2012 10:16:25
Klaus
Hallo Dirk,
eine Kleinigkeit noch: bitte ändere
  With Sheets(1)
Cells.Delete
End With
in
  With Sheets(1)
.Cells.Delete
End With
der Punkt dort ist wahnsinnig wichtig, sonst riskierst du dass dir das Makro eine aktive Tabelle komplett löscht!!
*MitFingerAufMazteZeig* von mir ist das nicht! :-)
Grüße,
Klaus M.vdT.

Hallo Matze, ich bin etwas böse mit dir :-)
18.12.2012 09:52:44
Klaus
Hi Matze,
aus meiner Codezeile (dieser Thread: https://www.herber.de/forum/messages/1290422.html)
Sheets(1).Range("A" & lRow2 + 1).PasteSpecial
hast du diese gemacht:
Sheets(1).Range("A" & lRow2).PasteSpecial
Das +1 hinter lRow2 stand da mit Absicht, und der arme Dirk weiss gar nicht wie ihm passiert ;-) Und ich les seinen neuesten Eintrag, lese den Code und wundere mich dass mein Code so einen bug hat ...
Grüße,
Klaus M.vdT.

Anzeige
Sorry Klaus,...weis auch nicht was mich
18.12.2012 16:48:06
Matze,Matthias
da geritten hat die 1 weg zumachen, naja nu ist ja alles wieder gut.
Matze

AW: Sorry Klaus,...weis auch nicht was mich
18.12.2012 19:14:54
dirk0011
jetzt bin ich echt verwirrt.muss ich jetzt noch was machen......

AW: Sorry Klaus,...weis auch nicht was mich
19.12.2012 06:02:40
Matze,Matthias
Hallo dirk0011,
wenn bei dir jetzt alles nach deinen Wünschen funktioniert, dann "nein" .
Wenn du dein Makro ausführts, sollte in dem Blatt Zusammenfassung die erste Zeile leer sein.
Möchtest du du dies "nicht haben" dann füge die Zeile:
Sheets(1).Rows(1).Delete nach Next i ein.
Klaus hat mich "auf meine gemachten Fehler" richtiger weise hingewiesen.
du kannst doch mit dem Code mal spielen, mach mal in jedes Blatt nur 3 Datensätze
und lass die +1 bei
Sheets(1).Range("A" & lRow2 + 1).PasteSpecial mal weg,
dann überschreibt er beim kopieren die Letzte Zeile eines Datensatzen Pro Blatt.
Und genau das war der Fehler den ich gemacht habe.
Matze

Anzeige
AW: Sorry Klaus,...weis auch nicht was mich
19.12.2012 10:04:42
dirk0011
Hallo zusammen,,
danke für eure Hilfe, bei mir sieht aber gerade alles gut aus..wenn nicht weiss ich ja wo ich euch finde :-))
Gruss
Dirk

AW: Sorry Klaus,...weis auch nicht was mich
19.12.2012 09:05:21
Klaus
Hallo Dirk,
nein, du musst (deswegen) nichts machen. Der Beitrag ging an Matze, nachdem deine Frage bereits gelöst war.
Aber bitte beachte meinen anderen Hinweis:
https://www.herber.de/forum/messages/1291335.html
Funktionieren sollte es ja bereits, das ist nur um zu verhindern dass du dir aus versehen ein noch benötigtes Blatt löscht.
Grüße,
Klaus M.vdT.
Anzeige

400 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige