AW: Spalten kopieren
01.10.2019 16:46:08
Dieter
Hallo Nick,
deiner Beschreibung nach hast du genau das Richtige gemacht. Aber im Zweifelsfall muss man immer den Code sehen.
Ich habe das Programm folgendermaßen ergänzt (am Schluss wird das Zielblatt aktiviert, um das Ergebnis zu zeigen):
Sub SpaltenKopieren()
Dim i As Long
Dim letzteZeile As Long
Dim mappeZ_vorhanden As Boolean
Dim spalteQ As String
Dim spalteZ As String
Dim spaltenQ As Variant
Dim spaltenZ As Variant
Dim wbQ As Workbook ' Quelle
Dim wbZ As Workbook ' Ziel
Dim wsQ As Worksheet
Dim wsZ As Worksheet
spaltenQ = Array("C", "D", "F", "G", "J")
spaltenZ = Array("A", "F", "I", "K", "X")
Set wbQ = ThisWorkbook
Set wsQ = wbQ.Worksheets(6)
For Each wbZ In Workbooks
If wbZ.Name = "Mappe1.xlsm" Then
mappeZ_vorhanden = True
Exit For
End If
Next wbZ
If Not mappeZ_vorhanden Then
MsgBox "Bitte ""Mappe1.xlsm"" öffnen"
Exit Sub
End If
Set wbZ = Workbooks("Mappe1.xlsm")
Set wsZ = wbZ.Worksheets(3)
For i = LBound(spaltenQ) To UBound(spaltenQ)
spalteQ = spaltenQ(i)
spalteZ = spaltenZ(i)
letzteZeile = wsQ.Cells(wsQ.Rows.Count, spalteQ).End(xlUp).Row
If letzteZeile > 2 Then
' ' Alternative 1: Nur Werte kopieren
' wsQ.Cells(3, spalteQ).Resize(letzteZeile - 2).Copy
' wsZ.Cells(3, spalteZ).PasteSpecial Paste:=xlValues
' Application.CutCopyMode = xlCut
' Alternative 2: Werte und Formatierungen kopieren
wsQ.Cells(3, spalteQ).Resize(letzteZeile - 2).Copy Destination:=wsZ.Cells(3, spalteZ)
End If
Next i
wsZ.Activate
End Sub
Anstelle der Nummern kannst du auch die Blattnamen verwenden. Wenn das 6. Blatt von Mappe2 z.B. "Kosten" heißt, dann schreibst du anstelle von
Set wsQ = wbQ.Worksheets(6)
das Statement
Set wsQ = wbQ.Worksheets("Kosten")
https://www.herber.de/bbs/user/132314.xlsm
Viele Grüße
Dieter