Thema Datum  Von Nutzer Rating
Antwort
14.09.2016 09:31:02 Peter
NotSolved
14.09.2016 14:16:08 Gast5216
NotSolved
14.09.2016 14:21:08 Gast20370
NotSolved
14.09.2016 15:17:49 Gast13997
NotSolved
14.09.2016 17:27:40 Andreas
NotSolved
Blau Selection vermeiden
15.09.2016 08:57:50 Peter
NotSolved

Ansicht des Beitrags:
Von:
Peter
Datum:
15.09.2016 08:57:50
Views:
726
Rating: Antwort:
  Ja
Thema:
Selection vermeiden
Guten Morgen, erstmal vielen für eure Hilfe :) Habe es nochmal ausprobiert, funktioniert aber leider bei mir nicht :( Vllt. findet ihr ja den Fehler Hier ist mehr von dem Code, er soll die weiteren Tabellen füllen, die Anzahl der Tabellen ist variabel. Bei mir funktioniert das nur mit dem umständlichen Code.. :/ FinalRow = Cells(Rows.Count, 25).End(xlUp).Row FinalRow2 = Cells(Rows.Count, 1).End(xlUp).Row For v = 1 To FinalRow YearValue = Cells(v, 25).Value For x = 5 To FinalRow2 ThisValue = Cells(x, 17).Value f = 4 + v If ThisValue = YearValue Then ActiveSheet.Cells(x, 2).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row + 1), 2).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 5).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 7).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 16).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 62).Select ActiveSheet.Paste Sheets("tabelle").Select ' Sheets(f).Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row + 1), 2).Value = Sheets("Tabelle1").Cells(x, 2).Value ' Sheets(f).Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 7).Value = Sheets("Tabelle1").Cells(x, 5).Value ' Sheets(f).Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 62).Value = Sheets("Tabelle1").Cells(x, 16).Value If Cells(x, 17) = Cells(x, 19) Then ActiveSheet.Cells(x, 12).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 3).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 13).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 4).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 14).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 5).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 15).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 6).Select ActiveSheet.Paste Sheets("tabelle").Select Else ActiveSheet.Cells(x, 12).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 3).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 13).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 4).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 19).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 5).Select ActiveSheet.Paste If Selection = "" Then Else With Selection.Interior .ColorIndex = 48 .Pattern = xlSolid End With End If Sheets("tabelle").Select ActiveSheet.Cells(x, 15).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 6).Select ActiveSheet.Paste ' Sheets("tabelle").Select ActiveSheet.Cells(x, 14).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 63).Select ActiveSheet.Paste ' Sheets("tabelle").Select End If Else ThisValue = Cells(x, 19).Value If ThisValue = YearValue Then ActiveSheet.Cells(x, 2).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row + 1), 2).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 9).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 7).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 16).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 62).Select ActiveSheet.Paste Sheets("tabelle").Select If Cells(x, 17) = Cells(x, 19) Then ActiveSheet.Cells(x, 12).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 3).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 13).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 4).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 14).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 5).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 15).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 6).Select ActiveSheet.Paste Sheets("tabelle").Select Else ActiveSheet.Cells(x, 17).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 3).Select ActiveSheet.Paste If Selection = "" Then Else With Selection.Interior .ColorIndex = 48 .Pattern = xlSolid End With End If ' Sheets("tabelle").Select ActiveSheet.Cells(x, 12).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 63).Select ActiveSheet.Paste ' Sheets("tabelle").Select ActiveSheet.Cells(x, 13).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 4).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 14).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 5).Select ActiveSheet.Paste Sheets("tabelle").Select ActiveSheet.Cells(x, 15).Select Selection.Copy Sheets(f).Select ActiveSheet.Cells(Application.Max(7, Cells(Rows.Count, 2).End(xlUp).Row), 6).Select ActiveSheet.Paste Sheets("tabelle").Select End If End If End If Next x Next v

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
14.09.2016 09:31:02 Peter
NotSolved
14.09.2016 14:16:08 Gast5216
NotSolved
14.09.2016 14:21:08 Gast20370
NotSolved
14.09.2016 15:17:49 Gast13997
NotSolved
14.09.2016 17:27:40 Andreas
NotSolved
Blau Selection vermeiden
15.09.2016 08:57:50 Peter
NotSolved