finden und kopieren von bestimmten Zellinhalten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Commandbutton1_click() Dim sh1, sh2 Dim lR%, lastlR%, i%, j%, mystart$, myend$ Dim startdate As Date, enddate As Date Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") mylR = 1 mystart = InputBox("Bitte geben Sie Startdatum ein") myend = InputBox("Bitte geben Sie Enddatum ein") For i = 1 To 4 Step 1 lR = sh1.Cells(Rows.Count, i).End(xlUp).Row If lR > mylR Then mylR = lR End If Next i startdate = FormatDateTime(mystart) enddate = FormatDateTime(myend) For j = 1 To mylR Step 1 If enddate < sh1.Cells(j, 1) Then Exit Sub End If If startdate >= sh1.Cells(j, 1) Then sh1.Range(Cells(j, 1), Cells(j, 4)).Copy Destination:=sh2.Cells(j, 1) End If Next j End Sub

Hallo Oliver,
danke für deine Antwort. Im Ansatz funktioniert es schon :-) Es ist ja gerade für Anfänger nicht so leicht, sich immer verständlich auszudrücken, daher habe ich dieses Mal eine Tabelle reingehängt. Wäre cool, wenn du noch einmal drüber schauen würdest.

Die Datei https://www.herber.de/bbs/user/5529.xls wurde aus Datenschutzgründen gelöscht

In Realität steht in Spalte 1 immer das Datum. Wenn ich auf den Button klicke, hinter dem dein Code liegt, fragt er mich nach Anfangs und Enddatum. Ich gebe z.B. 1 und 3 ein.
Folgendes passiert?
Ich bekomme in Tabelle 2 nur Zeile 1 von spalte a bis f kopiert
Was ich möchte
1. Excel soll den Vorgang so lange ausführen, bis alle Daten kopiert sind. (Bsp. In Spalte A würde stehen 1,1,4,3,5,3,4,1,2,5,3,4, und ich tippe ein Start = 1 und Ende = 3 möchte ich zunächst erreichen, dass Excel folgendes Ergegbnis liefert: 1,1,3,3,1,2,3.
2. Du siehst in Tabelle 1 Spalten B, C ... mit Zahlen ausgefüllt. Nach Code kopiert er nun die ersten 4 Spalten (wenn ich das richtig gesehen habe) und fügt sie in Tabelle 2 ein. Was ich brauche ist ein Code, den ich anpassen kann und mit dem ich genau vorgeben kann, welche Spalten kopiert werden sollen.
Hintergrund ist, dass ich ein Tabellenblatt mit dutzenden von Spalten habe und diese per Klick auf andere Tabellenblätter verteilen möchte. Da es sich dann aber hierbei um jeweilige Berichte handelt, muss ich genau festlegen können (aber nur im code, das muss der User nicht per Eingabe oder so machen), welche Spalte dann wo hinkommt.
Ich hoffe auf eine Antwort.
Gruß und Dank
Ulf

Private Sub CommandButton1_Click() Dim sh1, sh2 Dim lR%, mylR%, i%, j%, mystart%, myend%, mydate%, jcol% Dim startdate As Date, enddate As Date Dim myCols(5) Set sh1 = Sheets(1) mystart = InputBox("Bitte geben Sie Startdatum ein") myend = InputBox("Bitte geben Sie Enddatum ein") mysheet = InputBox("Bitte Geben Sie den Namen des Ziel-Sheets ein") mycolumn = InputBox("Bitte die zu kopierenden Spalten eingeben z.B. 1,2,3") mycol = Split(mycolumn, ",") lR = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'startdate = FormatDateTime(mystart) 'enddate = FormatDateTime(myend) i = 1 For j = 1 To lR Step 1 mydate = sh1.Cells(j, 1) If mystart <= mydate And myend >= mydate Then For icol = 0 To UBound(mycol) jcol = mycol(icol) sh1.Cells(j, jcol).Copy Destination:=Sheets(mysheet).Cells(i, jcol) Next icol i = i + 1 End If Next j End Sub

Hey nochmal,
Kommando zurück. Das Blatt heißt Tabelle2 und nicht tabelle2 :-) Diese Kleinigkeiten. Also, es läuft. Danke. Ich habe gesehen, dass jetzt wirklich nur die Spalten kopiert werden. Wenn ich 1,3 und 5 eingebe bleiben B und D als leere Spalten bestehen. Die können gleich gelöscht werden. Ich habe mal im Archiv geschaut und den Befehl gefunden


Private Sub CommandButton1_Click()
Cells.SpecialCells(xlCellTypeBlanks).Delete xlUp
End Sub

Der soll anscheinend -eingebettet ins Standardmodul- alle leeren Zeilen und Spalten löschen. Bei mir nicht. Passiert nix. Hast du eine andere Idee?
Gruß
Ulf
Bevor ich das vergesse: deine Lösung ist natürlich super elegant, weil der User jetzt auch noch selber eingeben kann, welche Spalten er kopieren will. Nehmen wir mal an, ich will wegen einem Standardreport nur 1,3 und 5 kopieren, wo muss ich das wie eintragen?
So, das war es dann hoffentlich mit dem Thema. danke für deine Mühen
Gruß
Ulf

Private Sub CommandButton1_Click() Dim sh1, sh2 Dim lR%, mylR%, i%, j%, mylC%, jcol% Dim mystart As Date, myend As Date, mydate As Date Dim myCols(5) Set sh1 = Sheets(1) mystart = InputBox("Bitte geben Sie Startdatum ein") myend = InputBox("Bitte geben Sie Enddatum ein") mysheet = InputBox("Bitte Geben Sie den Namen des Ziel-Sheets ein") mycolumn = InputBox("Bitte die zu kopierenden Spalten eingeben") If mycolum = "" Then mycolumn = "1,3,5" 'wenn input für Spalten leer, dann Standard End If mycol = Split(mycolumn, ",") lR = sh1.Cells(Rows.Count, 1).End(xlUp).Row i = 1 For j = 1 To lR Step 1 mylC = 1 mydate = sh1.Cells(j, 1) If mystart <= mydate And myend >= mydate Then For icol = 0 To UBound(mycol) jcol = mycol(icol) zlC = Sheets(mysheet).Range("IV1").End(xlToLeft).Column sh1.Cells(j, jcol).Copy Destination:=Sheets(mysheet).Cells(i, mylC) mylC = mylC + 1 Next icol i = i + 1 End If Next j End Sub

Beliebteste Forumthreads (12 Monate)

finden und kopieren von bestimmten Zellinhalten

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