Kleines Makro

Hallo,
ich verwende gerne den Makro-Aufzeichner um mir die Arbeit etwas zu erleichtern.
Leider kenne ich mich mit der Programmierung an sich gar nicht aus.
Ich habe mir ein kleines Makro aufgezeichnet, damit ich Werte aus einer Tabelle (Tab1) in eine andere Tabelle (Tab2)umsortiert kopieren kann. Das funktioniert natürlich ganz einfach, da es sich immer auf die gleiche Zelle bezieht.
Ich bräuchte bloss nun eine Funktion, dass die Werte aus Tab1 immer an die nächte freie Zelle der Tab2 kopiert. Also wahrscheinlich eine If - Then Schleife, oder?
Habe ein wenig probiert, aber ich bekomme das gar nicht hin, da ich leider nicht weiß, was ich genau brauche. Vielleicht kann mir ja jemand helfen.
Besten Dank im voraus.
Viele Grüße,
Patrick

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Kleines Makro

05.01.2015 10:18:13

Bernd

AW: Kleines Makro

05.01.2015 12:15:33

Bernd

AW: Kleines Makro

05.01.2015 12:19:56

Bernd

AW: Kleines Makro

05.01.2015 10:19:10

Beverly

AW: Kleines Makro

05.01.2015 10:49:35

Patrick

AW: Kleines Makro

05.01.2015 11:11:02

Beverly

AW: Kleines Makro

05.01.2015 11:24:07

Patrick

AW: Kleines Makro

05.01.2015 12:41:23

Beverly

AW: Kleines Makro

05.01.2015 12:50:29

Rudi

Sub Kopieren() Application.ScreenUpdating = False Dim a Dim b For Each cell In Selection a = cell.Value Sheets("Tab2").Select b = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 If Sheets("Tab2").Range("A1") = "" Then b = 1 Sheets("Tab2").Range("A" & b).Value = a Sheets("Tab1").Select Next Application.ScreenUpdating = True End Sub

Sub BereichTransponierenUndInFreieZeileKopieren() 'Kopiert einen transponierten Bereich der Tabelle1 'in die nächste freie Zeile der Tabelle2, Spalte O3 Sheets(1).Range("C3:GS6").Copy 'Bereich anpassen zeile = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 2 Sheets(2).Cells(zeile, 14).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False End Sub

Sub BereichTransponierenUndInFreieZeileKopieren() 'Kopiert einen transponierten Bereich der Tabelle1 'in die nächste freie Zeile der Tabelle2, Spalte A Sheets(1).Range("C3:GS6").Copy 'Bereich anpassen zeile = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets(2).Cells(zeile, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False End Sub

Dim lngLetzte As Long With Worksheets("Tabelle2") ' letzte belegte Zeile in Spalte A der Tabelle2 ermitteln lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _ Rows.Count) ' Bereich kopieren in erste freie Zeile Range("A1:Z1").Copy .Cells(lngLetzte + 1, 1) End With

Hallo, Ihr beiden,
vielen lieben Dank das Ihr helfen wollt. Sehe schon, ich muss da einiges lernen. VOr allem genauer erklären was ich genau mache.
Hier einfach mal mein Makro was ich aufgezeichnet habe:
Application.WindowState = xlMinimized
Range("C3:C6").Select
Selection.Copy
Windows("Tab1.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("O3").Select
Windows("Tab2.xls").Activate
Columns("C:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("C3").Select
Folgendes soll passieren:
Ich kopiere aus der Spalte C jeweils die Daten aus Zellen 3 bis 6. Danach springe in die meine andere Arbeitsmappe und kopiere die Sachen per Inhalte einfügen - Werte - Transponieren in die Zeile O (in dem Fall in O3).
Danach lasse ich die Spalten C und D löschen, damit der nächste Datensatz wieder in Spalte C steht. Die Spalte D ist nur eine Leerspalte.
Das würde ich gerne so lange machen, bis ich alle Datensätze (76) rüber kopiert habe.
Mit Eueren beiden Vorschlägen habe ich versucht das Makro anzupassen, aber das klappt leider gar nicht.
Hoffe ich konnte genauere Info liefern, was ich gerade versuche zu "verkünzeln" :-)

Sub xxxx() Dim i As Integer Application.ScreenUpdating = False With Workbooks("Tab2.xls").Sheets(1) For i = 3 To .Cells(4, .Columns.Count).End(xlToLeft).Column Step 2 .Cells(3, i).Resize(4).Copy With Workbooks("Tab1.xls").Sheets(1) .Cells(.Rows.Count, 15).End(xlUp).Offset(1).PasteSpecial _ Paste:=xlValues, Transpose:=True Application.CutCopyMode = False End With Next End With End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread