Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1252to1256
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1252to1256
1252to1256
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code anpassen

Code anpassen
Fritz_W
Hallo Forumsbesucher,
ich bitte die VBA-Experten um Hilfe bei der Anpassung des nachstehenden Codes unter den nachfolgend beschriebenen geänderten Bedingungen:
Sub Daten_uebertragen()
Dim i As Long
Dim letzteQuelle As Long
Application.ScreenUpdating = False
With Sheets("Tabelle2")
For i = 2 To 268 Step 19
letzteQuelle = .Cells(i, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(i, 3), .Cells(i + 16, letzteQuelle)).Copy
Sheets("Tabelle2b").Cells(i, Sheets("Tabelle2b").Cells(i, Sheets("Tabelle2b").Columns.  _
_
Count).End(xlToLeft).Column + 1).PasteSpecial Paste:=xlValue
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Es sollen nunmehr nicht mehr alle Bereiche der Quelldatei (Tabelle2) in die Zieldatei (Tabelle2b) übertragen werden, sondern nur noch die Bereiche, in denen in der Zelle über dem zu kopierenden Bereich als Wert ein 'x' eingetragen ist.
Beispiel für den ersten zu kopierenden Blockbereich (Zeilen 2 bis 17) der Tabelle2:
Nur diejenige Spalten kopieren (und wie bisher entsprechend nach Tabelle2b übertragen), wenn in der Zeile 1 ein 'x' steht. Also in Zelle C1 kein 'x' sollte C2:C17 nicht kopiert werden, in D1 ein 'x', sollte D2:D17 kopiert werden.
Für die nachfolgenden 14 Bereiche gilt Entsprechendes (Am Beispiel des zweiten zu kopierenden Blockbereichs: Zeilen 21:36):
Steht in C20 ein 'x' sollte C21:C36 kopiert werden, in D20 kein 'x' sollte D21:D36 nicht kopiert werden usw.
Ich freue mich über jede Unterstützung und danke im Voraus.
Viele Grüße
Fritz

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Code anpassen
02.03.2012 22:37:17
Fettertiger
Hallo Fritz,
wenn ich Dich richtig verstanden habe, dann sollte das so gehen: 
Sub Daten_uebertragen()
Dim i As Long
Dim letzteQuelle As Long
Application.ScreenUpdating = False
With Sheets("Tabelle2")
For i = 2 To 268 Step 19
letzteQuelle = .Cells(i, .Columns.Count).End(xlToLeft).Column
If LCase(.Cells(i, 3).Value) = "x" Then
.Range(.Cells(i, 3), .Cells(i + 16, letzteQuelle)).Copy
Sheets("Tabelle2b").Cells(i, Sheets("Tabelle2b").Cells(i, Sheets("Tabelle2b"). _
Columns.Count).End(xlToLeft).Column + 1).PasteSpecial Paste:=xlValue
End If
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Gruss
Theo
Anzeige
AW: Code anpassen
03.03.2012 09:20:57
Fritz_W
Hallo Theo,
vielen Dank für Deine Hilfe.
Die Ausführung des Makros wird mit der Meldung:
'Fehler beim Kompilieren: End If ohne If-Block'
abgebrochen.
Was muss geändert werden?
Viele Grüße
Fritz
AW: Code anpassen
03.03.2012 10:03:43
Hajo_Zi
Hallo Fritz,
Option Explicit
Sub Daten_uebertragen()
Dim i As Long
Dim letzteQuelle As Long
Application.ScreenUpdating = False
With Sheets("Tabelle2")
For i = 2 To 268 Step 19
letzteQuelle = .Cells(i, .Columns.Count).End(xlToLeft).Column
If LCase(.Cells(i, 3).Value) = "x" Then
.Range(.Cells(i, 3), .Cells(i + 16, letzteQuelle)).Copy
Sheets("Tabelle2b").Cells(i, Sheets("Tabelle2b").Cells(i, _
Sheets("Tabelle2b").Columns.Count).End(xlToLeft).Column _
+ 1).PasteSpecial Paste:=xlValue
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Code anpassen
03.03.2012 10:28:50
Fritz_W
Hallo Hajo,
herzlichen Dank für Deine Unterstützung.
Mit dem von Dir geänderten Code läuft das Makro nun ohne Fehlermeldung.
Leider leistet das Makro nicht das, was ich wollte.
Theo hat ja nicht ausgeschlossen, dass er mein Anliegen auch nicht richtig verstanden haben könnte, was nun offensichtlich der Fall ist.
Falls Du mir da weiterhelfen könntest, wäre ich Dir sehr dankbar. Bitte teil mir dann mit, falls Du ebenfalls Fragen hast. Ich werde mich nach Kräften bemühen, mein Anliegen nachvollziehbar zu formulieren, was mir leider manchmal - zumindest auf Anhieb - nicht gelingt.
Bis dahin viele Grüße und nochmaligen Dank.
Fritz
Anzeige
AW: Code anpassen
03.03.2012 10:31:39
Hajo_Zi
Hallo Fritz,
bei Herber sieht man nur den letzten Beitrag. Und in dem steht nicht Dein Problem.
Gruß Hajo
AW: Code anpassen
03.03.2012 10:46:35
Fritz_W
Hallo Hajo,
nachstehend die Beschreibung meines Anliegens, mit der Hoffnung, dass es für Dich nachvollziehbar ist.
Ansonsten ggf. bitte nochmals melden.
Danke und viele Grüße
Fritz
Ich bitte die VBA-Experten um Hilfe bei der Anpassung des nachstehenden Codes unter den nachfolgend beschriebenen geänderten Bedingungen:
Sub Daten_uebertragen()
Dim i As Long
Dim letzteQuelle As Long
Application.ScreenUpdating = False
With Sheets("Tabelle2")
For i = 2 To 268 Step 19
letzteQuelle = .Cells(i, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(i, 3), .Cells(i + 16, letzteQuelle)).Copy
Sheets("Tabelle2b").Cells(i, Sheets("Tabelle2b").Cells(i, Sheets("Tabelle2b"). _
Columns.  _
_
Count).End(xlToLeft).Column + 1).PasteSpecial Paste:=xlValue
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Es sollen nunmehr nicht mehr alle Bereiche der Quelldatei (Tabelle2) in die Zieldatei (Tabelle2b) übertragen werden, sondern nur noch die Bereiche, in denen in der Zelle über dem zu kopierenden Bereich als Wert ein 'x' eingetragen ist.
Beispiel für den ersten zu kopierenden Blockbereich (Zeilen 2 bis 17) der Tabelle2:
Nur diejenige Spalten kopieren (und wie bisher entsprechend nach Tabelle2b übertragen), wenn in der Zeile 1 ein 'x' steht. Also in Zelle C1 kein 'x' sollte C2:C17 nicht kopiert werden, in D1 ein 'x', sollte D2:D17 kopiert werden.
Für die nachfolgenden 14 Bereiche gilt Entsprechendes (Am Beispiel des zweiten zu kopierenden Blockbereichs: Zeilen 21:36):
Steht in C20 ein 'x' sollte C21:C36 kopiert werden, in D20 kein 'x' sollte D21:D36 nicht kopiert werden usw.
Anzeige
AW: Code anpassen
03.03.2012 10:54:06
Hajo_Zi
Hallo Fritz,
ich baue Dateien nicht nach, die Zeit hat schon jemand investiert. 
Option Explicit
Sub Daten_uebertragen()
Dim i As Long, LoI As Long
Dim letzteQuelle As Long
Application.ScreenUpdating = False
With Sheets("Tabelle2")
For i = 2 To 268 Step 19
letzteQuelle = .Cells(i, .Columns.Count).End(xlToLeft).Column
For LoI = 3 To letzteQuelle
If LCase(.Cells(i - 1, LoI).Value) = "x" Then
.Range(.Cells(i, LoI), .Cells(i + 16, LoI)).Copy
Sheets("Tabelle2b").Cells(i, Sheets("Tabelle2b").Cells(i, _
Sheets("Tabelle2b").Columns.Count).End(xlToLeft).Column _
+ 1).PasteSpecial Paste:=xlValue
End If
Next LoI
Next
End With
Application.ScreenUpdating = True
End Sub
Gruß Hajo
Anzeige
AW: Code anpassen
03.03.2012 11:06:59
Fritz_W
Hallo Hajo,
ich erwarte nicht, dass Du die Datei nachbaust. Zu sehr schätze ich die großartige uneigennützige Hilfe von Dir und den vielen anderen kompetenten Helfern. Vermeidbare und überflüssige Arbeit möchte ich allen Helfern ersparen, aber leider macht ich halt ab und zu Fehler bzw. gibt es auch Fehleinschätzungen meinerseits:
Es bestand - für mich leider schwer einzuschätzen - die Möglichkeit, dass der ursprüngliche Code und die Beschreibung der gänderten Bedingungen ausreichen, damit mir geholfen werden kann. Jetzt weiß ich, dass das nicht so ist.
Nochmaligen Dank und viele Grüße
Fritz
Anzeige
AW: Code anpassen
03.03.2012 11:09:13
Hajo_Zi
Hallo Fritz,
bein einigen Code muss man sehen wie es läuft um ihn auf die neuen Bedingungen anzupassen. Du hast keine Beschreibung geliefert was Dein bisheriger Code macht, nur was er machen soll und das hätte man an einer Datei vielleicht gesehen.
Gruß Hajo
AW: Code anpassen
03.03.2012 12:00:49
Fritz_W
Hallo Hajo,
vielen Dank für die Info. Genau das konnte ich eben nicht einschätzen.
Möglicherweise stelle ich morgen noch eine genauere Beschreibung rein und lade eine Beispielmappe hoch.
Brauch ich aber entsprechend Zeit, denn ich will dann ja möglichst hilfreiche Informationen liefern.
Viele Grüße
Fritz
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige