Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
164to168
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
164to168
164to168
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

kopiere wenn Zahl > 1

kopiere wenn Zahl > 1
04.10.2002 18:50:23
helen
Hallo
einfache Frage möchte wenn in Blatt 1 Spalte A:A markiert ist sämtliche Inhalte >1 auswählen und nach Blatt 2 kopieren mit VBA in Spalte B:B --> Spaltenwahl von Blatt 1 möchte ich immer manuell ausführen

DAnke helen

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

Betreff
Datum
Anwender
Anzeige
Re: kopiere wenn Zahl > 1
04.10.2002 22:25:25
davidx
Da gibts wahrscheinlich mal wieder x-Varianten, hab Die hier mal eine gepostet.
Probiers mal!:-)
Bin VBA-Anfänger, aber bei mir klappts, gibt wahrscheinlich noch kürzere Varianten!
Hoffe Dir geholfen zu haben, CU & mfg DAVIDX


Sub Makro1()
For Each zelle In Selection
If zelle > 1 Then
Sheets("Blatt 1").Activate
ZellAdresse = zelle.AddressLocal
ZellAdresse = Right(ZellAdresse, Len(ZellAdresse) - 2) 'entfernt das $A
ZellAdresse = "$B" & ZellAdresse 'fügt $B ein
zelle.Copy
Sheets("Blatt 2").Activate
Range(ZellAdresse).Select
ActiveSheet.Paste
End If
Next
End Sub

Anzeige
geht nicht kopiere wenn Zahl > 1
05.10.2002 10:02:11
Helen
vielleicht ist es einfacher wenn ich von Quelle beliebige Spalte manuell markiere und dann MAcro starte und alle Zellinhalte desen Wertigkeit z.B >1 und dann in ein neues File kopiere Spalte B:B
Bin Anfängerin
DANKE Helen
Re: kopiere wenn Zahl > 1
05.10.2002 15:27:12
helen
Sub kopiere_wenn_zahl_gr()
Dim Wert As Double
Dim Zelle
Dim Name
Wert = Application.InputBox("Welche Werte sollen kopiert werden. Größer als", "Werteeingabe", 0, Type:=1)
Workbooks.Add
Name = ActiveWorkbook.Name
ThisWorkbook.Activate
For Each Zelle In Selection
If IsNumeric(Zelle) Then
If Zelle > Wert Then
With Workbooks(Name).Worksheets("Tabelle1")
.Cells(.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = Zelle
End With
End If
End If
Next
Workbooks(Name).Worksheets("Tabelle1").Rows(1).Delete
End Sub

danke DAVID so funktioniert es --> nach neuem File und Spalte "B"
unter Hilfe von Hajo, SUPER mit INPUT_BOX

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige