Spalten H & I in ein neues Tabellenblatt kopieren

Hallo zusammen,
wie man schon an meinem Level erkenne kann, bin ich ein Anfänger was VBA angeht.
Nun zu meinem Problem.
Ich habe ein Tabellenblatt mit dem Namen "Stammdaten" in diesem fängt
ab der 18 Zeile in den Spalten H und I folgende Tabelle an. Es folgen noch weitere Spalten, diese benötige ich aber nicht.
PSP-Element Bezeichnung
K.12000.02.1.001 Planung Bau + Statik
K.12000.02.1.002 Planung TGA + Elektro
K.12000.02.1.003 Qualifizierungen Räume und Anlagen (RLT)
K.12000.02.1.004 Ingenieurleistungen
K.12000.02.1.005 Honorare, Gebühren, Gutachten
K.12000.02.1.006 Zeichnungen, Studien, Sonstiges
K.12000.02.2 Bau
K.12000.02.2.001 Roh-/Stahlbauarbeiten
K.12000.02.2.002 Fenster-/Fassadenarbeiten
Nun möchte ich mit einem Makro welches mir die beiden Spalten kopiert und in ein neues Tabellenblatt in der gleichen Arbeitsmappe welches "Übersicht" heißt diese Daten in die Splaten E & F ab der Zeile 25 kopiert.
Ich benötige deshalb ein Makro weil die Spalten unterschiedlich lang sind. Und das Makro soll bis zu letzten Zeile gehen und anschleißend alles kopieren.
Ich freue mich über eine Nachricht.
Beste Grüße
maggifrosch

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Henning alias maggifrosch,
hier mein Lösungsvorschlag.
Gruß
Franz

Sub PSP_Stammdaten_nach_Uebersicht()
Dim wksStamm As Worksheet, wksUeber As Worksheet, intFehler As Long
On Error GoTo Fehler
intFehler = 1
Set wksStamm = Worksheets("Stammdaten")
intFehler = 2
Set wksUeber = Worksheets("Übersicht")
intFehler = 0
With wksStamm
'entweder Zellen mit Formaten/Formeln kopieren
'    .Range(.Cells(18, 8), .Cells(.Rows.Count, 8).End(xlUp).Offset(0, 1)).Copy _
Destination:=wksUeber.Cells(25, 4)
'oder nur Zellinhalte kopieren
.Range(.Cells(18, 8), .Cells(.Rows.Count, 8).End(xlUp).Offset(0, 1)).Copy
wksUeber.Cells(25, 4).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
Fehler:
With Err
Select Case .Number
Case 0 'kein Fehler
Case Else
If intFehler = 2 Then 'Blatt Übersicht existiert noch nicht
ActiveWorkbook.Worksheets.Add
Set wksUeber = ActiveSheet
wksUeber.Name = "Übersicht"
Resume Next
ElseIf intFehler = 1 Then
MsgBox "Blatt Stammdaten fehlt"
Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End If
End Select
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Spalten H & I in ein neues Tabellenblatt kopieren

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

318 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten H & I in ein neues Tabellenblatt kopieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

318 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread