Jede x. Zelle markieren VBA

[Waldmensch15]

Ich habe eine sehr große Excel-Datei und will dabei folgende Teile markieren und kopieren
--> Immer im Abstand von 2

Range("B2,B6:B11,D2,D6:D11,F2,F6:F11").Select

Kann mir bitte jemand helfen wie ich daraus ein VBA Makro schreibe, dass bis einschließlich Spalte UO geht.
Würde mir sehr helfen.
Vielen Dank im Voraus.

[schauan]

Hallöchen,

eine Variante ohne VBA wäre eine bedingte Formatierung, im Prinzip =REST(SPALTE();2)=0 (oder 1)

Im VBA dann z.B. eine Schleife

For iCnt=1 to xxx Step 2
Columns(iCnt).Interior.Color = 255
Next

statt xxx dann die Spaltennummer von UO

[Kuwer]

Hallo André,

bleibt nur das Problem mit dem Kopieren.

Gruß Uwe

[DbSam]

Hallo Uwe,

... bleibt nur das Problem mit dem Kopieren.

... was nirgendwo in der Fragestellung richtig beschrieben ist.

Vermutung:
Per VBA Zellen selektieren, dann per Hand kopieren?


Gruß Carsten

[Kuwer]

Hallo Carsten,

Hallo Uwe,
... was nirgendwo in der Fragestellung richtig beschrieben ist.

Vermutung:
Per VBA Zellen selektieren, dann per Hand kopieren?

Ich habe eine sehr große Excel-Datei und will dabei folgende Teile markieren und kopieren
--> Immer im Abstand von 2

ist für mich verständlich beschrieben.

Und wie auch immer, André`s Code markiert auch nichts.

Gruß Uwe

[schauan]

Hallöchen,

Klar, jede zweite Spalte wird rot markiert Ansonsten hatte ich wohl Flecken auf der Brille

[DbSam]

Hallo Uwe,

Ich habe eine sehr große Excel-Datei und will dabei folgende Teile markieren und kopieren
--> Immer im Abstand von 2

... ist für mich verständlich beschrieben.

Also für mich ist das nicht verständlich genug beschrieben.
Die Markiererei ist beschrieben, gut. Aber wohin soll das 'Zeugs' kopiert werden?
Aus dem Screenshot kann man sich das auch nicht entnehmen. Jedenfalls ich nicht. Kann ja auch an mir liegen ...

Wie auch immer, ich habe da mal was für den Anfang gebastelt.
Das 'Problem' ist die Größe der Mehrfachselektion, deshalb in einzelne Bereiche gesplittet und diese dann zusammengesetzt.
Der besseren Anpassbarkeit wegen, haben ich die benötigten Namen am Anfang aufgeführt. Diese halt bei Bedarf anpassen ...
Vielleicht gibt es auch einen besseren Weg, um solch eine Menge von verschiedenen Zellbereichen zu selektieren. Ich kenne im Moment keinen besseren.

Code:

Sub MonsterRange()
On Error GoTo Er
Dim s As String, BName As String, TabName As String, i As Long
    
    TabName = "Tabelle1"
    BName = "Test"
    
    With ActiveWorkbook
        .Sheets(TabName).Activate
        CreateName BName & "_01", TabName, 2, 100
        CreateName BName & "_02", TabName, 102, 200
        CreateName BName & "_03", TabName, 202, 300
        CreateName BName & "_04", TabName, 302, 400
        CreateName BName & "_05", TabName, 402, 500
        CreateName BName & "_06", TabName, 502, 561
        For i = 1 To 6
            s = s & ActiveWorkbook.Name & "!" & BName & "_0" & i & ","
        Next i
        DeleteName BName
        .Names.Add Name:=BName, RefersToR1C1:="=" & Left(s, Len(s) - 1)
        Application.Goto Reference:=BName
        Selection.Copy
        
        'So, jetzt wird das 'Zeugs' irgendwohin kopiert.
        'Ist halt nicht genau definiert:
        .Sheets(TabName).Range("A14").Select
        .Sheets(TabName).Paste
        Application.CutCopyMode = False
        .Sheets(TabName).Range("B2").Select
    End With

Ex:
    Exit Sub
Er:
    MsgBox Err.Description
End Sub

Sub CreateName(ByVal BName As String, ByVal TabName As String, ByVal iFrom As Integer, ByVal iTo As Integer)
On Error GoTo Er
Dim i As Integer, s As String
        DeleteName BName
        For i = iFrom To iTo Step 2
            s = s & TabName & "!R2C" & i & "," & TabName & "!R6C" & i & ":R11C" & i & ","
        Next i
        ActiveWorkbook.Names.Add Name:=BName, RefersToR1C1:="=" & Left(s, Len(s) - 1)
Ex:
    Exit Sub
Er:
    MsgBox Err.Description
End Sub

Sub DeleteName(ByVal BName As String)
Dim bb As Name
    For Each bb In ActiveWorkbook.Names
        If bb.Name = BName Then bb.Delete
    Next bb
End Sub

Nun harren wir der Bemerkungen die da kommen werden ...
Hoffentlich sind da auch Erklärungen mit dabei. ;)


Gruß Carsten

[Kuwer]

Hallo Carsten,

sorry, ich habe mir Deinen Code jetzt nicht näher angesehen.  

Das ist meine Antwort auf Deine gestellte Frage, Orang-Utan Nr. 15:  :19:

Sub BereichMarkierenUndKopieren()
 Dim rngB As Range, rngZ As Range
 Dim i As Long
 Set rngZ = Range("2:2,6:11")
 Set rngB = Application.Intersect(rngZ, Columns(2))
 For i = 4 To 561 Step 2
   Set rngB = Application.Union(rngB, Application.Intersect(rngZ, Columns(i)))
 Next i
 rngB.Select
 rngB.Copy
End Sub

Gruß Uwe

[DbSam]

Hallo Uwe,

ja, schön kurz. :)
Bekommt man aber so in keinen benamten Bereich hinein. Schade.


Gruß Carsten

[Kuwer]

Hallo Carsten,

Bekommt man aber so in keinen benamten Bereich hinein. Schade.

Hauptsache, Du verstehst es, wovon Du sprichst. Die Erwähnung Benannter Bereiche konnte ich in der Ausgangsfrage nicht finden.

Gruß Uwe