Zelleninhalte in eine andere tabelle kopieren?

[MwieMichel]

Hallo fwerner,
ich gehe davon aus, dass in Zeile 1 die Überschrift steht, und das ab Zeile 2 kopiert werden soll. Sonst muss ggf. NA angepasst werden. Die folgende Routine überschreibt auf Blatt 2 alles. Wenn das nicht erwünscht ist, muss ggf. angepasst werden.
Zum Code Einfügen mit Alt + F11 in VBE wechseln. Ggf. neues Modul einfügen mit Einfügen // Modul. Dann diesen Code reinkopieren:

’ Variablen deklarieren
Dim BN1 As String, BN2 As String, AN As String, BS As String, D As String
Dim N1 As Single, N2 As Single, NA As Single, NE As Single
Dim M1 As Single, M2 As Single, M3 As Single

Sub Kopieren()
’ Blattnamen
With ActiveWorkbook
BN1 = .Sheets(1).Name
BN2 = .Sheets(2).Name
’ Letzte Zeile ermitteln, initialisieren
.Sheets(BN1).Activate
’ Application.ScreenUpdating = False
With ActiveWorkbook.ActiveSheet
NE = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
MsgBox ("letzte Zeile " & NE)
NA = 2
N2 = NA
’ Kopieren
For N1 = NA To NE
AN = Cells(N1, 1).Value
BS = Cells(N1, 2).Value
D = Cells(N1, 8).Value
M1 = Cells(N1, 9).Value
M2 = Cells(N1, 10).Value
M3 = M1 + M2
If M3 > 0 Then
Einfuegen
End If
With ActiveWorkbook
Sheets(BN1).Activate
End With
Next
End With
’ Application.ScreenUpdating = False
.Sheets(BN2).Activate
End With
End Sub

Private Sub Einfuegen()
’ Einfuegen
With ActiveWorkbook
.Sheets(BN2).Activate
With ActiveWorkbook.ActiveSheet
Cells(N2, 1).Value = D
Cells(N2, 2).Value = AN
Cells(N2, 3).Value = BS
Cells(N2, 4).Value = M1
Cells(N2, 5).Value = M2
N2 = N2 + 1
End With
End With
End Sub

Mit Alt + F11 auf Excel-Umgebung zurück und Routine mit Alt + F8 starten. Bitte mit erst mit Kopie des Excelsheets testen.

MfG MwieMichel

[Nico_MoD]

Ich bin mir jetzt nicht sicher was du genau meinst. Deine verschiebung der werte ist nicht ganz klar. Aber analog zu dem beispiel unten solltest du mit etwas vba kenntinissen klar kommen.
Tip:
Speicher bevor du das makro ausführst, fals die schleife endlos läuft und du excel abschiessen musst.

Sub tuwas()
'schleife der spalte 1 bis zeile leer ist
Dim i =1 'wenn eine überschrift da ist, ansonsten 0
Do
i=i+1
If worksheets(„tabelle1“).cells(i,9)"" or worksheets(„tabelle1“).cells(i,11)"" then '9 = Spalte I; 11=K
worksheets(„tabelenblatt2).cells(i,2).Formula=worksheets(„tabelle1“).cells(i,1).Value
’ schreibt wert aus tabelle 1 spalte a solange in tabelle 2 spalte b wenn in der zeile der spalte a tabelle 1 ein wert enthalten ist. Trifft die schleife auf eine leere zeile ist die rschleife zu ende
End if
Loop until worksheets(„tabelle1“).cells(i,1).value=“"

End sub

[fwerner]

Danke an alle die mir geantwortet haben!!! sehr gute antworten!!!

bei dieser Lösung würde ich noch was verbessern:

Sub Transfer()
Dim Zeile1 As Integer
Dim Zeile2 As Integer

Zeile1 = 2
Zeile2 = 2
Do While (Sheets(„Tabelle1“).Cells(Zeile1, 8).Value „“)
If (Sheets(„Tabelle1“).Cells(Zeile2, 9).Value „“ Or Sheets(„Tabelle1“).Cells(Zeile2, 11) „“) Then
Sheets(„Datum1“).Cells(Zeile2, 1) = Sheets(„Tabelle1“).Cells(Zeile1, 8)
Sheets(„Datum1“).Cells(Zeile2, 2) = Sheets(„Tabelle1“).Cells(Zeile1, 1)
Sheets(„Datum1“).Cells(Zeile2, 3) = Sheets(„Tabelle1“).Cells(Zeile1, 2)
Sheets(„Datum1“).Cells(Zeile2, 4) = Sheets(„Tabelle1“).Cells(Zeile1, 9)
Sheets(„Datum1“).Cells(Zeile2, 5) = Sheets(„Tabelle1“).Cells(Zeile1, 11)

Zeile2 = Zeile2 + 1

End If

Zeile1 = Zeile1 + 1

Loop

End Sub

Hier möchte ich noch, wenn die Do-Schleife erfüllt ist und die Werte dann in dem Tabellenblatt „Datum1“ stehen, die Werte in der Spalte 2, wenn die kleiner als 2 Stellen (z.B. 12=>gelb und 123=>bleibt so)besitzen, mit der gelben Hintergrundfarbe markieren.

so in der Art:

If ((Sheets(„Datum1“).Cells(Zeile1, 2) >= 2) Then
Sheets(„Datum1“).Cells(Zeile1, 2).Interior.ColorIndex = 6
End If

Brauche ich dafür eine extra Schleife?
wie kann man die werte die weniger als zwei zahlen besitzen aussortieren?

[fwerner]

Danke dir für deine sehr gute antworten!!!

bei dieser Lösung würde ich noch was verbessern:

Sub Transfer()
Dim Zeile1 As Integer
Dim Zeile2 As Integer

Zeile1 = 2
Zeile2 = 2
Do While (Sheets(„Tabelle1“).Cells(Zeile1, 8).Value „“)
If (Sheets(„Tabelle1“).Cells(Zeile2, 9).Value „“ Or Sheets(„Tabelle1“).Cells(Zeile2, 11) „“) Then
Sheets(„Datum1“).Cells(Zeile2, 1) = Sheets(„Tabelle1“).Cells(Zeile1, 8)
Sheets(„Datum1“).Cells(Zeile2, 2) = Sheets(„Tabelle1“).Cells(Zeile1, 1)
Sheets(„Datum1“).Cells(Zeile2, 3) = Sheets(„Tabelle1“).Cells(Zeile1, 2)
Sheets(„Datum1“).Cells(Zeile2, 4) = Sheets(„Tabelle1“).Cells(Zeile1, 9)
Sheets(„Datum1“).Cells(Zeile2, 5) = Sheets(„Tabelle1“).Cells(Zeile1, 11)

Zeile2 = Zeile2 + 1

End If

Zeile1 = Zeile1 + 1

Loop

End Sub

Hier möchte ich noch, wenn die Do-Schleife erfüllt ist und die Werte dann in dem Tabellenblatt „Datum1“ stehen, die Werte in der Spalte 2, wenn die kleiner als 2 Stellen (z.B. 12=>gelb und 123=>bleibt so)besitzen, mit der gelben Hintergrundfarbe markieren.

so in der Art:

If ((Sheets(„Datum1“).Cells(Zeile1, 2) >= 2) Then
Sheets(„Datum1“).Cells(Zeile1, 2).Interior.ColorIndex = 6
End If

Brauche ich dafür eine extra Schleife?
wie kann man die werte die weniger als zwei zahlen besitzen aussortieren? …

[fwerner]

ich meine: wenn die werte in der spalte B, bleibt wie es war
B3: 12 => bekommt eine gelbe Hintergrundfarbe

[Nico_MoD]

Sorry, aber deine eingehende frage hat jetzt wenig mit mit dem jetzt zu tun?
Was heisst kleinergleich 2 zahlen? Kleinegleich 2 oder kleiner 10?

if worksheets(„tabelle1“).cells(i,9).value

[fwerner]

sorry, ich meine 2 oder 3 stellige zahlen

[Peter_a00871]

Hallo,

kann es sein das es sich hier irgendwie um eine schulische Hausaufgabe handelt?

Ok, anyway

========================================
’ eine kleine Funtion die das Problem loesen sollte
’ etwas ausfuehlicher… koennte man auch kompakter und vieleicht eleganter loesen, aber so sollte es leichter verstaendlich sein.

’ Declarationen
’ Braucht man um die Zeilen zu durchlaufen
Dim startIdx As Integer
Dim endIdx As Integer
Dim aktIdx As Integer
’ braucht man um die Cellen zu referenziern
Dim txtCell_1 As String
Dim txtCell_2 As String
Dim txtCell_3 As String
Dim txtCell_4 As String

'hier muesste Start bzw. Ende gesetzt werden, welche Zeile gehts los, wann ist schluss. Man koennte sie auch ermitteln…

startIdx = 2
endIdx = 100

’ laufen wir durch die Zeilen
For aktIdx = startIdx To endIdx

’ zusammenbau des aktuellen Zellennamen
txtCell_1 = „I“ & aktIdx
txtCell_2 = „K“ & aktIdx

’ Die Bedingung wenn was kopiert werden soll
’ ewt. je nach Zellenformat nicht auf „“ pruefen sondern auf 0 oder Null

If Worksheets(„Blatt1“).Range(txtCell_1).Value „“ Or Worksheets(„Blatt1“).Range(txtCell_2).Value „“ Then
'--------------------------
’ was jetzt kommt fuer jede Zelle die kopiert werden
’ soll entsprechend wiederholen
'Quellzellen name
txtCell_3 = „A“ & aktIdx
’ Zielzellen name
txtCell_4 = „B“ & aktIdx

Worksheets(„Blatt2“).Range(txtCell_4).Value = Worksheets(„Blatt1“).Range(txtCell_3).Value
'--------------------------------------------------
End If

Next aktIdx

'===========================================

Mal so schnell hingeschrieben und nicht wirklich getestet, aber sollte so schon funktionieren.

Dann musst du nur noch einen Ausloeser fuer die Funktion festlgen.

Hope this helps
Tschau

Peter

[Nico_MoD]

Das ist eigentlich ebenso privitiv. Man grenze die 2-3 stelligen zahelen ein in form von >9 und 9 and worksheets(„tabelle1“).cells(i,9).value

[Wolfgang_Hupka]

Hallo

Sub Makro1()
Dim spalte_a As Variant
Dim spalte_b As Variant
Dim spalte_h As Date
Dim spalte_k As Variant
Dim spalte_l As Variant
Dim x As Variant

'Zelle A1 selektieren
Range(„a1“).Select

'Die folgende Schleife solange durchlaufen, wie in Zelle der Spalte A Inhalt steht
Do While ActiveCell.FormulaR1C1 „“

'Wenn in Zelle der Spalte K oder Spalte L ein Wert steht
If ActiveCell.Offset(0, 10).FormulaR1C1 „“ Or ActiveCell.Offset(0, 11).FormulaR1C1 „“ Then
'Werte der einzelnen Zellen in Variable speichern
spalte_a = ActiveCell.FormulaR1C1
spalte_b = ActiveCell.Offset(0, 1).FormulaR1C1
spalte_h = ActiveCell.Offset(0, 7).FormulaR1C1
spalte_k = ActiveCell.Offset(0, 10).FormulaR1C1
spalte_l = ActiveCell.Offset(0, 11).FormulaR1C1

'Werte in Tabelle2 kopieren
Kopieren spalte_a, spalte_b, spalte_h, spalte_k, spalte_l

End If
Sheets(„Tabelle1“).Select
'eine Zeile nach unten gehen
ActiveCell.Offset(1, 0).Select

Loop
End Sub

Private Sub Kopieren(ByVal A As Variant, ByVal B As Variant, _
ByVal H As Date, ByVal K As Variant, ByVal L As Variant)

'Tabelle2 aktivieren und in Zelle A1 gehen
Sheets(„Tabelle2“).Select
Range(„a1“).Select

'Freie Zeile in Tabelle2 suchen
Do While ActiveCell.FormulaR1C1 „“
'Wenn aktiver Zellinhalt belegt ist, gehe eine Zeile nach unten
If ActiveCell.FormulaR1C1 „“ Then
ActiveCell.Offset(1, 0).Select
End If
Loop

'Leere Zelle in Spalte A wurde gefunden
'Jetzt Werte in Tabelle2 einfügen
'Spalte A
ActiveCell.FormulaR1C1 = H
'Spalte B
ActiveCell.Offset(0, 1).FormulaR1C1 = A
'Spalte C
ActiveCell.Offset(0, 2).FormulaR1C1 = B
'Spalte D
ActiveCell.Offset(0, 3).FormulaR1C1 = L
'Spalte E
ActiveCell.Offset(0, 4).FormulaR1C1 = K
End Sub

[OVMueller]

Also du brauchst nicht noch mal extra eine schleife machen. Du kannst die andere gleich mit verwenden und baust da ein:

Select Case len(Sheets(„Tabelle1“).cells(zeile1,1).value)
'len gibt die länge eine strings zurück
Case 0:
'Leerer string
Sheets(„Tabelle1“).cells(zeile1,1).interior.colorindex = 4
case 1:
'Ein Zeichen
Sheets(„Tabelle1“).cells(zeile1,1).interior.colorindex = 8
case 4:
'Vier Zeichen
Sheets(„Tabelle1“).cells(zeile1,1).interior.colorindex = 12
Case else:
'Alle anderen zeichenlängen
end select

[fwerner]

sorry das ich nicht rechtzeitig melden konnte, danke für deine Hilfe, bin mit eineer habe noch eine sub geschrieben, jetzt läuft das!!! allerdings habe ich noch eine anforderung, wenn ich selbst nicht klar komme, dann melde ich mich! danke noch mal!

[fwerner]

Danke an alle die mir geholfen haben!!!

[fwerner]

Hallo OVMueller,

brächte noch deine hilfe!

die spalte B sieht so aus:

huglöuh
huhfuw
hglz145
summe1
äüijh
kkiru
summe2
khgkugz
jhgklzg
hglöh
summe3
jg
kuzfi
jkirt
summe4

Ausgabe als Beispiel in debugprint Summe1 und Summe3:
huglöuh
huhfuw
hglz145
summe1
khgkugz
jhgklzg
hglöh
summe3

möchte das zuerst die artikeln und dann die summe 1 angezeigt wird und dann wieder artikeln und summe3, das kriege ich nicht hin!

wenn du zeit hast, würde ich mich über deine hilfe freuen!

[OVMueller]

Keine Ahnung was du damit meinst xD

[fwerner]

versuche noch mal die aufgabenstellung zu erklären: in der spalte a stehen die artikelnnummern, in der spalte B stehen artikelbezeichnungen in der spalte c sind die bestellungen und in der spalte d erhaltene bestellungen.

die liste ist beliebig lang. ziel ist wenn die artikeln in den spalten bestellungen und erhaltene bestellungen werte haben, dann sollen die artikeln mit nummer, bezeichnung, und bestellungen und erhaltenen bestell. in ein anderes tabellenblatt kopiert werden.

das kopieren in anderes tabellenblatt klappt schon, aber folgendes problem: in der spalte b stehen auch artikelgruppenbezeichnungen und in dem anderen tabellenblatt möchte ich nicht alle artikelgruppenbezechnungen haben,zum beispiel:

Spalte B:
kuli rot
bleistift rot
heft rot
summe rot
kuli grün
heft grün
radiergimmi grün
summe grün
heft rosa
summe rosa

[OVMueller]

Dann nimmst du einfach auf dem zweiten Blatt einen Filter.

LG ovm

[Anonym_9ff9f3990509]

Hallo fwerner
Sorry für die späte Antwort. Ich war in den Ferien.

Bevor ich mich da ran setze, hat sich das Problem gelöst, oder brauchst du noch Hilfe?

Gruss Jochen11

[fwerner]

danke Jochen das problem das sich gelöst.

habe aber nächstes…

[Anonym_9ff9f3990509]

Dann nur her damit, oder im Board posten.

danke Jochen das problem das sich gelöst.

habe aber nächstes…