Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1172to1176
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Kopieren mit VBA
Basti
Hallo liebe Leute,
ich habe ein kleines "Kopier-Problem":
Ich habe in Spalte B ca. 100 Namen, von denen einige gleich sind. Durch sortieren stehen die gleichen Namen untereinander. In den Spaten C-X sind zusätzliche Informationen zu den Namen.
Ich versuche jetzt schon seit einer gefühlten Ewigkeit ein Makro zu schreiben, dass die gleichen Namen auswählt, diese dann mit den entsprechenden Spalten B-X in ein neues Arbeitsblatt kopiert und dabei die Spalten transponiert. (Das was vorher in Spalten stand soll nun in Zeilen).
Kann mir jemand bei meinem Problem weiterhelfen?
Herzlichen Dank!
Sebastian

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Unterliegt das nicht dem KopyRight ;-) ?
25.08.2010 15:15:07
NoNet
Hallo Sebastian,
hier ein passendes Makro dazu :
Sub KopyRight()
Dim wsAkt As Worksheet, wsNeu As Worksheet
Dim lngZvon As Long, lngZBis As Long, lngZ As Long, lngLZ As Long
Set wsAkt = ActiveSheet
lngLZ = Cells(Rows.Count, 2).End(xlUp).Row
For lngZ = 2 To lngLZ
If (Cells(lngZ, 2)  Cells(lngZ - 1, 2) And Cells(lngZ, 2)  "") Or _
lngZ = lngLZ Then
'Falls letzte Zeile :
If lngZ = lngLZ Then
If Cells(lngZ, 2)  Cells(lngZ - 1) Then lngZvon = lngZ
lngZBis = lngZ
End If
If lngZvon = 0 Then
lngZvon = lngZ
lngZBis = lngZ
Else
Set wsNeu = Sheets.Add(after:=Sheets(Sheets.Count))
wsNeu.Name = wsAkt.Cells(lngZvon, 2)
wsAkt.Range("B" & lngZvon & ":X" & lngZBis).Copy
wsNeu.[A1].PasteSpecial Transpose:=True
wsNeu.[A1].Select
Application.CutCopyMode = False
wsAkt.Activate
lngZvon = lngZ
lngZBis = lngZ
End If
Else
If Cells(lngZ, 2)  "" Then lngZBis = lngZ
End If
Next
End Sub
Gruß, NoNet
Anzeige
AW: Unterliegt das nicht dem KopyRight ;-) ?
25.08.2010 15:23:41
Basti
Du hat mir seeehr viel Arbeit ersparrt!
Vielen herzlichen Dank!!!
Grüße,
Basti
mein Makrorekorder hat das hier ...
25.08.2010 15:20:08
Matthias
Hallo
... aufgezeichnet
Das ist nur ein Beispiel !
Sub Makro1()
' Makro1 Makro
' Makro am 25.08.2010 von Matthias L. aufgezeichnet
Selection.AutoFilter Field:=1, Criteria1:="Peter Müller" 'bitte anpassen
Rows("1:4").Select' bitte Anpassen!
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Tabelle2").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

Userbild
Gruß Matthias
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige