Microsoft Excel

Herbers Excel/VBA-Archiv

Makro wiederholen mit Zelle darunter


Betrifft: Makro wiederholen mit Zelle darunter von: Roman Bürger
Geschrieben am: 14.07.2017 10:13:49

Hallo zusammen,

ich als Praktikant habe die Aufgabe bekommen einen Prozess in Excel zu automatisieren. Es geht darum in den Zellen zu erkennen was darin steht und dann je nachdem eine passende Grafik aus einem anderen Sheet zu kopieren, und sie in ein neues Sheet einzufügen. Ich bin soweit gekommen dass es für die erste Zeile funktioniert, jedoch suche ich nach einer Möglichkeit das Makro für die nächste Zeile zu verwenden. Wichtige Info dazu: In meinem Makro wird explizit die Zelle genannt. Der Code sieht wie folgt aus:

Sub Modulnummer_1()

'Modulnummer 1
    
    If Range("B2").Value = "PS-24" Then
    Sheets("Vorlagen").Select
    Range("A1:F17").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    Exit For
    ElseIf Range("B2").Value = "AS-P" Then
    Sheets("Vorlagen").Select
    Range("A19:F35").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "DO-FA-12-H" Then
    Sheets("Vorlagen").Select
    Range("A55:F71").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "DO-FC-8-H" Then
    Sheets("Vorlagen").Select
    Range("A73:F89").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "AO-V-8-H" Then
    Sheets("Vorlagen").Select
    Range("A109:F125").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "AO-8-H" Then
    Sheets("Vorlagen").Select
    Range("A127:F143").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "DI-16" Then
    Sheets("Vorlagen").Select
    Range("A253:F269").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "RTD-DI-16" Then
    Sheets("Vorlagen").Select
    Range("A271:F287").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "UI-8.AO-4-H" Then
    Sheets("Vorlagen").Select
    Range("A289:F305").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "UI-8.AO-V-4-H" Then
    Sheets("Vorlagen").Select
    Range("A307:F323").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "UI-8.DO-FC-4-H" Then
    Sheets("Vorlagen").Select
    Range("A325:F341").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste
    ElseIf Range("B2").Value = "UI-16" Then
    Sheets("Vorlagen").Select
    Range("A343:F359").Select
    Selection.Copy
    Sheets("ttt").Select
    Range("A1").Select
    ActiveSheet.Paste

    End If
    
    
    
End Sub


Danke im Vorraus

MfG Roman Bürger

  

Betrifft: AW: Makro wiederholen mit Zelle darunter von: UweD
Geschrieben am: 14.07.2017 10:38:50

Hallo Roman

Erstmal: auf select kann in 99% verzichtet werden.


dann musst du eine Schleife drumlegen..

- hier mal Beispiel für 2 bis 10
- was innderhalb dann anders gehandhabt werden soll,kann ich nicht wissen

Sub Modulnummer_1()
    Dim RNG As Range
    With Sheets("Vorlagen")
        For i = 2 To 10 'anpassen
            Select Case .Cells(i, 2) 'Spalte2 =B
                Case "PS-24"
                    Set RNG = .Range("A1:F17")
                Case "AS-P"
                    Set RNG = .Range("A19:F35")
                Case "DO-FA-12-H"
                    Set RNG = Range("A55:F71")
                '...usw.
                Case "UI-16"
                    Set RNG = .Range("A343:F359")
            
            End Select
            
            RNG.Copy Sheets("ttt").Range("A1")
        Next
    End With
End Sub

LG UweD


  

Betrifft: AW: Makro wiederholen mit Zelle darunter von: Roman Bürger
Geschrieben am: 19.07.2017 10:00:34

Hallo Uwe

Meine aktuelle Schleife funktioniert schon, nur muss der Bereich in der meine Grafik eingefügt wird nach jedem Durchgang um 18 Zeilen nach unten geschoben werden. Derzeit ist es so dass die Schleife zwar läuft, jedoch wird die "gefundene" Grafik immer in die Zelle A1 eingefügt. Sie müsste aber beim ersten Durchgang in A1 eingefügt werden, beim zweiten Durchgang in A19 usw...
Leider habe ich es nicht geschafft den Code der in der Antwort steht in meinen einzufügen..

Grüße Roman


  

Betrifft: AW: Makro wiederholen mit Zelle darunter von: UweD
Geschrieben am: 20.07.2017 09:56:41

Hallo


Sub Modulnummer_1()
    Dim RNG As Range, i As Integer, Vers As Integer
    
    With Sheets("Vorlagen")
        For i = 2 To 10 'anpassen 
            Select Case .Cells(i, 2) 'Spalte2 =B 
                Case "PS-24"
                    Set RNG = .Range("A1:F17")
                Case "AS-P"
                    Set RNG = .Range("A19:F35")
                Case "DO-FA-12-H"
                    Set RNG = Range("A55:F71")
                '...usw. 
                Case "UI-16"
                    Set RNG = .Range("A343:F359")
            
            End Select
            
            If Not RNG Is Nothing Then
                RNG.Copy Sheets("ttt").Range("A1").Offset((i - 2) * 18, 0)
                Set RNG = Nothing
            End If
        Next
    End With
End Sub

LG UweD


Beiträge aus den Excel-Beispielen zum Thema "Makro wiederholen mit Zelle darunter"