Thema Datum  Von Nutzer Rating
Antwort
08.07.2019 10:38:30 Andrea
NotSolved
08.07.2019 10:50:52 ANdrea
NotSolved
08.07.2019 13:51:24 Gast59027
NotSolved
08.07.2019 13:52:47 Gast59027
NotSolved
08.07.2019 20:56:53 Gast2506
NotSolved
Blau Zellen aus Spalten vaiable übernehmen und anfügen
10.07.2019 03:51:23 Werner
NotSolved
10.07.2019 11:10:05 Andrea
NotSolved
10.07.2019 12:57:12 Gast59027
NotSolved
10.07.2019 13:34:18 Werner
*****
NotSolved
19.07.2019 14:42:06 Gast26468
NotSolved

Ansicht des Beitrags:
Von:
Werner
Datum:
10.07.2019 03:51:23
Views:
479
Rating: Antwort:
  Ja
Thema:
Zellen aus Spalten vaiable übernehmen und anfügen

Hallo Andrea,

Punkt 1:

für eine saubere Darstellung des Codes benutze bitte einen anderen Browser (Firefox z.B.) dann wird dir oben in der Icon-Leiste eine rote Klammer angezeigt über die du den Code in den Beitrag einfügen kannst.

 

Punkt 2:

deine letzte Bemerkung: klappt leider nicht ist nicht hilfreich

Wenn ich das richtig sehe, dann willst du in einer Schleife über alle Tabellenblätter beginnend mit Blatt 5.

Nur wenn im jeweiligen Blatt in der Zelle C1 ein Wert ist, dann soll kopiert werden.

Du schreibst, dass du mehrere Spalten kopieren willst, welche das aber sind verrätst du leider nicht.

Teste mal den Code. Der läuft in einer Schleife über die Blätter, ab Nr. 5, prüft ob in C1 ein Wert ist und läuft dann in einer weiteren Schleife über die Spalten C bis E.

In jeder Spalte wird dann zunächst die letzte belegte Zelle ermittelt und dann der Bereich von Zeile 1 bis zur letzten belegten Zelle ins Zielblatt kopiert. Dann gehts weiter mit der nächsten Spalte.

 

Option Explicit

Sub KopiereBereich()
Dim i As Long, z As Long
Dim loLetzteQuelle As Long, loLetzteZiel As Long

'Schleife über die Worksheets
For i = 5 To Worksheets.Count
    With Worksheets(i)
        If .Cells(1, 3) <> "" Then
            'Schleife über die Spalten
            '3=C bis 5=E
            For z = 3 To 5
                'Ermitteln der letzten belegten Zelle der jew. Spalte
                loLetzteQuelle = .Cells(.Rows.Count, z).End(xlUp).Row
                'Bereich kopieren
                .Range(.Cells(1, z), .Cells(loLetzteQuelle, z)).Copy
                With Worksheets("Test")
                    'Ermitteln der ersten freien Zeile in Spalte 16
                    loLetzteZiel = .Cells(.Rows.Count, 16).End(xlUp).Offset(1).Row
                    'kopierten Bereich einfügen
                    .Cells(loLetzteZiel, 16).PasteSpecial Paste:=xlPasteValues, Transpose:=True
                End With
            'nächste Spalte
            Next z
        End If
    End With
'nächstes Blatt
Next i

End Sub

 

Gruß Werner


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
08.07.2019 10:38:30 Andrea
NotSolved
08.07.2019 10:50:52 ANdrea
NotSolved
08.07.2019 13:51:24 Gast59027
NotSolved
08.07.2019 13:52:47 Gast59027
NotSolved
08.07.2019 20:56:53 Gast2506
NotSolved
Blau Zellen aus Spalten vaiable übernehmen und anfügen
10.07.2019 03:51:23 Werner
NotSolved
10.07.2019 11:10:05 Andrea
NotSolved
10.07.2019 12:57:12 Gast59027
NotSolved
10.07.2019 13:34:18 Werner
*****
NotSolved
19.07.2019 14:42:06 Gast26468
NotSolved