Code verändern, aber wie

Bild

Betrifft: Code verändern, aber wie
von: RalfF
Geschrieben am: 04.12.2003 17:59:41

Noch ein Versuch, ich habe schon einmal versucht Hilfe auf den unten stehenden Code zu bekommen, leider ohne Erfolg, hoffe das nun jemand diesen Hilferuf liest. Gruß, RalfF. Danke an PeterW

Hallo Exceler, ich habe ein Problem mit dem unten aufgeführten Code. Der ist
super in der Anwendung, sollte aber dennoch eine kleine Verbesserung
bekommen. Er holt aus den ersten 3 Blättern der Datei Daten und bringt sie
auf das 4te Dateiblatt. Soweit so gut. Kann man den Code (und wie?) so
ändern, das die Daten die auf das 4te Blatt gebracht werden, einen Abstand
von 15 Spalten bekommen? In der jetzigen Variante haben die Daten nur 1
Spalte als Leerzeile. Würde mich freuen wenn ihr dafür eine Lösung finden
könntet, ich selber habe keine rechte Ahnung über VB. Danke, Ralf




Sub aktual() 
Application.ScreenUpdating = False 
For i = 1 To 3 
Sheets(i).Activate 
Range("B11").Select 
Range(Selection, Selection.End(xlDown)).Select 
For Each cell In Selection 
If cell.Value > 99999 Then 
konto = cell.Value 
End If 
cell.Offset(0, -1).Value = konto 
Next 
Next i 
Dim y As Integer 
Sheets(4).Activate 
Range("a1").Activate 
For i = 1 To 3 
Sheets(4).Activate 
ActiveCell.Offset(1, 0).Activate 
Sheets(i).Activate 
Range("B11").Select 
Range(Selection, Selection.End(xlDown)).Select 
For Each cell In Selection 
If cell.Offset(0, -1).Value > 99999 Then 
Sheets(4).Activate 
If ActiveCell.Offset(-1, 0).Value <> cell.Offset(0, -1).Value Then 
ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 2).Value 
If IsEmpty(cell.Offset(-1, 3).Value) = False Then 
ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 3).Value 
End If 
ActiveCell.Value = cell.Offset(0, -1).Value 
ActiveCell.Offset(1, 0).Activate 
End If 
If ActiveCell.Offset(-1, 0).Value = cell.Offset(0, -1).Value Then 
If IsEmpty(cell.Offset(0, 3).Value) = True Then 
ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 2).Value 
End If 
If IsEmpty(cell.Offset(0, 3).Value) = False Then 
ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 3).Value 
End If 
End If 
Sheets(i).Activate 
ActiveCell.Offset(1, 0).Activate 
End If 
Next 
Next i 
For i = 1 To 3 
Sheets(i).Activate 
Range("B11").Select 
Range(Selection, Selection.End(xlDown)).Select 
For Each cell In Selection 
If cell.Value > 99999 Then 
konto = cell.Value 
End If 
cell.Offset(0, -1).ClearContents 
Next 
Next i 
Application.ScreenUpdating = True 
End 

Sub 
   
 
  
Bild


Betrifft: AW: Code verändern, aber wie
von: NE
Geschrieben am: 04.12.2003 19:41:07

Abend Ralf,

... aber wie, ... DAS wüsste ich auch gern.

Also super in der Anwendung würde ich nun nicht behaupten, zumal Variablen fehlen und
ich mir anfangs nicht sicher war, ob bei dem Code der 'Kopierteufel' zugeschlagen hat ;-)

Egal, hatte mal die fehlenden Variablen ergänzt, um zu schauen, was Du denn so tust.
Es ist mühsam, deine Mappe zu simulieren und das ewige activate/select tut sein übriges.

So eine kleine Beispieldatei mit deinen vier Blättern und Eintragungen wär schon was feines ...

lg Nancy


Bild


Betrifft: AW: Code verändern, aber wie
von: RalfF
Geschrieben am: 04.12.2003 19:57:53



Hoffe das es klaptt, Gruß, Ralf


https://www.herber.de/bbs/user/2315.xls


Bild


Betrifft: AW: Code verändern, aber wie
von: RalfF
Geschrieben am: 04.12.2003 19:58:28



Hoffe das es klaptt, Gruß, Ralf


https://www.herber.de/bbs/user/2315.xls


Bild


Betrifft: AW: Code verändern, aber wie
von: NE
Geschrieben am: 04.12.2003 20:09:42

Hiho Ralf,

ich meinte zwar kleine Datei, mal schauen wann der Download fertig ist ...
Armer server ;-)

lg Nancy


Bild


Betrifft: AW: Code verändern, aber wie
von: RalfF
Geschrieben am: 04.12.2003 20:33:40

Hallo "IG Nancy",

ich weiß nicht was ich falsch gemacht haben soll, habe nur meine Excel Datei mit 4 Blättern hochgeladen...


Gruß, RalfF


Bild


Betrifft: AW: Code verändern, aber wie
von: NE
Geschrieben am: 04.12.2003 21:02:48

Hallo Ralf,

passt scho', wenns Dir nix ausmacht, das ist mir für heute Abend bissel zu anstrengend,
muss ich morgen mal in Ruhe versuchen zu verstehen. Vielleicht hat ja derweil ein andrer noch Vorschläge ...

lg Nancy
--
BTW, lg = liebe Grüsse ;-)


Bild


Betrifft: AW: Code verändern, aber wie
von: NE
Geschrieben am: 05.12.2003 15:14:32

Hallo Ralf,

hab's mal versucht. Allerdings find' ich den Code ziemlich sch...,
anyway, habe alles andre so gelassen, bis auf das eine Offset(15,0), sh.Kommentar.
Die betreffende Zeile kannst Du eigentlich gleich bei Dir ändern.
Zu Risiken & Nebenwirkungen fragen Sie Ihren ... ;-)

HTH Nancy
--


Sub test()
Application.ScreenUpdating = False
For i = 1 To 3
Sheets(i).Activate
Range("B11").Select
Range(Selection, Selection.End(xlDown)).Select
For Each cell In Selection
If cell.Value > 99999 Then
konto = cell.Value
End If
cell.Offset(0, -1).Value = konto
Next
Next i
Dim y As Integer
Sheets(4).Activate
Range("a1").Activate
For i = 1 To 3
Sheets(4).Activate
'****************************************************************
'******** hier 15 Leerzeilen = offset(Zeile,Spalte) *************
'****************************************************************
ActiveCell.Offset(15, 0).Activate '<<<<<<<<<<<<<<<<--------------
Sheets(i).Activate
Range("B11").Select
Range(Selection, Selection.End(xlDown)).Select
For Each cell In Selection
If cell.Offset(0, -1).Value > 99999 Then
Sheets(4).Activate
If ActiveCell.Offset(-1, 0).Value <> cell.Offset(0, -1).Value Then
ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 2).Value
If IsEmpty(cell.Offset(-1, 3).Value) = False Then
ActiveCell.Offset(-1, 1).Value = cell.Offset(-1, 3).Value
End If
ActiveCell.Value = cell.Offset(0, -1).Value
ActiveCell.Offset(1, 0).Activate
End If
If ActiveCell.Offset(-1, 0).Value = cell.Offset(0, -1).Value Then
If IsEmpty(cell.Offset(0, 3).Value) = True Then
ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 2).Value
End If
If IsEmpty(cell.Offset(0, 3).Value) = False Then
ActiveCell.Offset(-1, 1).Value = cell.Offset(0, 3).Value
End If
End If
Sheets(i).Activate
ActiveCell.Offset(1, 0).Activate
End If
Next
Next i
For i = 1 To 3
Sheets(i).Activate
Range("B11").Select
Range(Selection, Selection.End(xlDown)).Select
For Each cell In Selection
If cell.Value > 99999 Then
konto = cell.Value
End If
cell.Offset(0, -1).ClearContents
Next
Next i
Application.ScreenUpdating = True
End Sub



Bild


Betrifft: AW: Code verändern, aber wie
von: RalfF
Geschrieben am: 05.12.2003 16:24:51

Hallo Nancy,

vielen, vielen Dank, das war es. Das eine kleine Zahl an der richtigen Stelle so bewirken kann.....

Frohe Weihnachten euch allen, Gruß RalfF


Bild


Betrifft: oki. erledigt ...
von: NE
Geschrieben am: 05.12.2003 20:31:23

... da bin ich ja mal froh ;-)

BTW, wenns denn überhaupt einer bei dem Traffic hier liest ...

Kommentieren hat IMHO noch nie geschadet,
ebensowenig wie Einrückungen ;-)
(damit meine ich nicht Dich Ralf)

Danke für's Feedback & ebenso Merry Christmas

Nancy


Bild

Beiträge aus den Excel-Beispielen zum Thema " nur Zellen und Spalten mit Inhalt kopieren"