Office: einzelne kopierte bereich untereinander eunfügen.

Hallo euch allen,
Ich hoffe jemand kann mir bei meinem Problem weiterhelfen. Ich zeige schon mal was ich bisher habe.
Sub niO()

Dim i As Long, j As Long
For i = 16 To 42
j = 16
Sheets("Stecker_01a").Select
If Range("O" & i) = "X" Then
Range("F" & i, "O" & i).Copy
Sheets("Abweichungen_01").Select
Range("F" & j).Select
ActiveSheet.Paste
End If
Next
j = j + 1
End Sub

Grundsätzlich soll das Makro abfragen, ob in der Spalte O ein X steht. Wenn ein X da ist soll der in diese Zeile einen betimmten Bereich kopieren und diese dann in einem anderen Arbeitsblatt einfügen. Das ganze klappt soweit mit einem Wert. Sobald mehr Zeilen zu kopieren gilt:Bei meinem Makro fügt er den zu kopierenden Bereich immer in die Zelle F16. der soll aber so hatte ich es vor mit j=j+1 eine Zeile runter gehen sprich G16 den 2ten Bereich einfügen, für den dritten Bereich in H16 einfügen etc. komm einfach nicht drauf was man da macht.

Liebe Grüße Suny

 

Hi Suny,

bei deinem Code setzt du in jeder Schleife zu Beginn j auf 16, sodass die Erweitung auf die nächste Zeile, die du korrekt mit j = j + 1 festlegst, immer wieder zurückgesetzt wird. Versuche es mal so:

Code:

Sub niO()
   Dim i As Long, j As Long
   j = 16
   With Sheets("Stecker_01a")
      For i = 16 To 42
         If .Range("O" & i) = "X" Then
            .Range("F" & i, "O" & i).Copy Sheets("Abweichungen_01").Range("F" & j)
            j = j + 1
         End If
      Next
   End With
End Sub

Bis später,
Karin

 

Hallo Karin,
danke dir vielmals, es klappt. hätte nie gedacht, dass es an der positionierung von j =16 liegt. ich werde deine Form übernehmen. sieht eleganter aus und ohne select, flackert auch das bild nicht so.
Hätte noch eine andere Frage wie würde das Makro aussehen wenn es jetzt mehrere Arbeitsblätter betrifft, sprich Stecker_01a, Stecker_01b, ..c etc. Klappt schon mal nett wenn ich einfach

with sheets("stecker_01a","stecker_01b") mache.

Gruß Suny

 

Hi Suny,

Code:

Sub niO()
   Dim i As Long, j As Long
   Dim arrTabs()
   Dim lngTabs As Long
   ' in das Array alle Tabellennamen schreiben, die durchlaufen werden sollen
   arrTabs() = Array("Stecker_01a", "Stecker_01b", "Stecker_01c", "Stecker_01d", "Stecker_01e")
   j = 16
   For lngTabs = 0 To 4
      With Sheets(arrTabs(lngTabs))
         For i = 16 To 42
            If .Range("O" & i) = "X" Then
               .Range("F" & i, "O" & i).Copy Sheets("Abweichungen_01").Range("F" & j)
               j = j + 1
            End If
         Next
      End With
   Next lngTabs
End Sub

Bis später,
Karin

 

Hi Karin,
danke für das super Makro, funktioniert wie gewünscht. Echt klasse wieder eine neue Funktion gelernt.

Liebe grüße Suny

 

Hi Suny,

schön dass es deinen Wünschen entsprechend funktioniert.

Einen Hinweis möchte ich noch geben, was Arrays betrifft: sie beginnen standardmäßig immer bei 0, was man beim Schleifendurchlauf über die Array-Inhalte berücksichtigen muss - deshalb (wenn sich 5 Inhalte im Array befinden):

For lngTabs = 0 To 4


Es gibt allerdings auch die Möglichkeit, Arrays bei 1 beginnen zu lassen, was in Ausnahmefällen günstiger ist. In derartigen Situation schreibt man zu Beginn des Codemoduls (also noch vor das erste Makro) diese Zeile

Code:

Option Base 1

Sie bedeutet (logischerweise), dass alle Arrays bei 1 beginnen.

Bis später,
Karin