Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1324to1328
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
Inhaltsverzeichnis

Zellwerte über schleife kopieren

Zellwerte über schleife kopieren
12.08.2013 20:19:15
Frank
Guten Abend,
habe lange in der recherche gesucht und siehe da auch das passende Makro für meine Problenmlösung gefunden. Bräuchte aber eine klitzekleine Änderung welche mich aber doch vor etwas größere Probleme stellt. Folgendes makro hat Harald Kapp ins Forum gestellt.
In allen mappen ausser tabelle3 wird in Spalte A der name gesucht welcher in tabelle3 in Zelle D1 vermerkt ist. In dem makro wird die komplette gefundene zeile kopiert. das möchte ich nicht. Wenn der zellwert gefunden wurde soll bitte nur der Bereich der spalten F bis AA in Tabelle3 Zeile 8 Spalte Y kopiert werden. Habe bei Destination meine mühe. Wär jemand so nett und kann sich das mal anschauen. Danke Frank
Sub test()
Dim Tabelle As Worksheet
Dim Name As String
Dim Zeile As Long
Dim firstAddress As String
Dim Suchzelle As Range
Zeile = 8
Name = Worksheets("Tabelle3").Range("D1").Text
For Each Tabelle In ActiveWorkbook.Worksheets
If Tabelle.Name  "Tabelle3" Then
Tabelle.Activate
With Tabelle.Range("A:A")
Set Suchzelle = .Find(Name, LookIn:=xlValues)
If Not Suchzelle Is Nothing Then
firstAddress = Suchzelle.Address
Do
Rows(Suchzelle.Row).Select
Selection.Copy
ActiveSheet.Paste Destination:=Worksheets("Tabelle3").Range(Zeile & ":" &  _
Zeile)
Zeile = Zeile + 1
Set Suchzelle = .FindNext(Suchzelle)
Loop While Not Suchzelle Is Nothing And Suchzelle.Address  firstAddress
End If
End With
End If
Next Tabelle
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellwerte über schleife kopieren
13.08.2013 16:39:46
Balder
Hallo Frank,
hier der umgeschriebene Quelltext:
Sub test()
Dim Tabelle As Worksheet
Dim Name As String
Dim Zeile As Long
Dim firstAddress As String
Dim Suchzelle As Range
Dim i As Long
Zeile = 8
Name = Worksheets("Tabelle3").Range("D1").Text
For Each Tabelle In ActiveWorkbook.Worksheets
If Tabelle.Name  "Tabelle3" Then
Tabelle.Activate
With Tabelle.Range("A:A")
Set Suchzelle = .Find(Name, LookIn:=xlValues)
If Not Suchzelle Is Nothing Then
firstAddress = Suchzelle.Address
Do
For i = 6 To 26
Sheets("Tabelle3").Cells(Zeile, i + 19) = _                             _
Sheets(Tabelle).Cells(Suchzelle.Row, i)
Next
Zeile = Zeile + 1
Set Suchzelle = .FindNext(Suchzelle)
Loop While Not Suchzelle Is Nothing And Suchzelle.Address  firstAddress
End If
End With
End If
Next Tabelle
End Sub
...ich finde es im Allgemeinen etwas eigenartig geschrieben... Geschmackssache. ...sollte so funktionieren.
Gruß
Balder

Anzeige
AW: Zellwerte über schleife kopieren
13.08.2013 17:27:33
Balder
Hallo Frank,
hier der umgeschriebene Quelltext:
Sub test()
Dim Tabelle As Worksheet
Dim Name As String
Dim Zeile As Long
Dim firstAddress As String
Dim Suchzelle As Range
Dim i As Long
Zeile = 8
Name = Worksheets("Tabelle3").Range("D1").Text
For Each Tabelle In ActiveWorkbook.Worksheets
If Tabelle.Name  "Tabelle3" Then
Tabelle.Activate
With Tabelle.Range("A:A")
Set Suchzelle = .Find(Name, LookIn:=xlValues)
If Not Suchzelle Is Nothing Then
firstAddress = Suchzelle.Address
Do
For i = 6 To 26
Sheets("Tabelle3").Cells(Zeile, i + 19) = _                             _
Sheets(Tabelle).Cells(Suchzelle.Row, i)
Next
Zeile = Zeile + 1
Set Suchzelle = .FindNext(Suchzelle)
Loop While Not Suchzelle Is Nothing And Suchzelle.Address  firstAddress
End If
End With
End If
Next Tabelle
End Sub
...ich finde es im Allgemeinen etwas eigenartig geschrieben... Geschmackssache. ...sollte so funktionieren.
Gruß
Balder

Anzeige
AW: Zellwerte über schleife kopieren
13.08.2013 18:53:15
Frank
Hallo Balder, Danke dass du Dich meiner angenommen hast.
Bekomme aber bei
Sheets("Tabelle3").Cells(Zeile, i + 19) = Sheets(Tabelle).Cells(Suchzelle.Row, i)
die Fehlermeldung Typen unverträglich! Laufzeitfehler 13
Da das Workbook ne ganze menge Tabellenblätter hat und ich eigentlich davon nur 4 bräuchte - könnte man die suche auf diese 4 beschränken. Heißen simpel Tabelle1,...usw bis Tabelle4. Schönen Abend noch - Gruß Frank

AW: Zellwerte über schleife kopieren
13.08.2013 19:03:51
Frank
Hallo Balder, Danke dass du Dich meiner angenommen hast.
Bekomme aber bei
Sheets("Tabelle3").Cells(Zeile, i + 19) = Sheets(Tabelle).Cells(Suchzelle.Row, i)
die Fehlermeldung Typen unverträglich! Laufzeitfehler 13
Da das Workbook ne ganze menge Tabellenblätter hat und ich eigentlich davon nur 4 bräuchte - könnte man die suche auf diese 4 beschränken. Heißen simpel Tabelle1,...usw bis Tabelle4.
Schönen Abend noch -
Gruß Frank

Anzeige
AW: Zellwerte über schleife kopieren
15.08.2013 10:41:09
Hajo_Zi
Hallo Frank,
vielleicht so
Sheets("Tabelle3").Cells(Zeile, i + 19) = Sheets("Tabelle").Cells(Suchzelle.Row, i)
oder
Sheets("Tabelle3").Cells(Zeile, i + 19) = Tabelle.Cells(Suchzelle.Row, i)

AW: Zellwerte über schleife kopieren
15.08.2013 13:30:43
Frank
Hallo Hajo, deinen ersten Vorschlag den Gedanken hatte ich auch schon - selbe Fehlermeldung. Das zweite kann ich erst heute nacht ausprobieren. Melde mich in jedem Fall. Es gibt in dem Workbook Tabellenblätter welche versteckt sind und es auch bleiben müssen. Nicht,das es was damit zu tun hat. Deswegen war meine zweite frage,ob man das durchsuchen auf Blätter beschränken könnte. Gruss Frank

Anzeige
AW: Zellwerte über schleife kopieren
16.08.2013 03:15:43
Frank
Hallo Hajo und Balder,
letzteres hat funktioniert. Supi -- Danke für eure Hilfe.
Gruß Frank

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige