Zelleninhalte in eine andere tabelle kopieren?

Computer: Software & Programmierung Office Software
1

Hallo,

bin nicht so fit in vba und brächte jetzt Eure Hilfe!

Problembeschreibung:

gegeben ist eine exceldatei mit zwei tabellenblättern: tabellenblatt 1:

in spalte A stehen Artikelnummern, in B stehen Beschreibungen, in H stehen Datum, in I und K stehen artikelmengen, I und K sind nicht immer belegt.

mit vba hilfe soll ich: wenn I oder K belegt sind, dann sollen die werte vom tabellenblatt 1 in das tabellenblatt 2, spalteA in die spalte B, spalte B in die Spalte C, spalte H in die Spalte A, I in die D und K in die E.

Hoffe Ihr könnt mir helfen!!!

LG fwerner

2

Hallo fwerner,

sub Transfer()
dim cRow1 as integer
dim cRow2 as integer
cRow1 = 1
cRow2 = 1

do until sheets(1).cells(cRow1,1).value = „“
if sheets(1).cells(cRow1,9).value „“ Or sheets(1).cells(cRow1,11).value „“ then
'Übertrage die zellen
sheets(2).cells(cRow2,1).value = sheets(1).cells(cRow1,1).value
sheets(2).cells(cRow2,2).value = sheets(1).cells(cRow1,2).value
sheets(2).cells(cRow2,3).value = sheets(1).cells(cRow1,3).value
sheets(2).cells(cRow2,4).value = sheets(1).cells(cRow1,4).value
sheets(2).cells(cRow2,5).value = sheets(1).cells(cRow1,5).value
’ … and so on
cRow2 = cRow2 + 1
end if
cRow1 = cRow1 + 1
loop

end sub

Hab ich jetzt nicht getestet, aber so müsste das funktionieren. Musst du evtl noch anpassen

Beste Grüße
OVM

3

danke erstmal, ich teste gleich dann melde ich mich!

4

Do Until (Sheets(Tabelle1).Cells(cRows1, 1).Value = „“)

beim schleifen anfang sagt er mir: laufzeitfehler „13“ typen unverträglich

woran könnte es denn liegen???

5

also entweder sprichst du das sheet wie folgt an

sheets(1)… > laufende Nummer der Zeichenblätter
oder
sheets(„Tabelle1“)… > Name des Blattes

Lg

6

danke vielmals, aber ich habe eine riesige tabelle und der code bearbeitet nur die erste zeile und macht nichts mehr, gibt es denn möglichkeiten diesen prozess zu automatisieren?

bedanke mich im voraus!!!

7

Hallo,

habe leider erst am Freitag Zeit,eine vernünftige Antwort zugeben.
Wennst bis dahin noch nicht weiter gekommen bist, helfe ich gerne

LG fred

8

also eigentlich sollte der alle zeilen durchgehen, bis in der jeweiligen zeile/ spalte A kein wert mehr drin steht. Falls also in spalte A mal eine leere Zelle kommt, dann bricht er ab.

alternativ:

sub Transfer()
dim cRow1 as integer
dim cRow2 as integer
cRow2 = 1

for cRow1 = 1 to 500 ’ Arbeitet das bis Zeile 500 durch
if sheets(1).cells(cRow1,9).value „“ Or sheets(1).cells(cRow1,11).value „“ then
'Übertrage die zellen
sheets(2).cells(cRow2,1).value = sheets(1).cells(cRow1,1).value
sheets(2).cells(cRow2,2).value = sheets(1).cells(cRow1,2).value
sheets(2).cells(cRow2,3).value = sheets(1).cells(cRow1,3).value
sheets(2).cells(cRow2,4).value = sheets(1).cells(cRow1,4).value
sheets(2).cells(cRow2,5).value = sheets(1).cells(cRow1,5).value
’ … and so on
cRow2 = cRow2 + 1
end if
next cRow1

end sub

… mehr auf http://www.wer-weiss-was.de/app/query/display_query?..

9

bzw.

for cRow1 = 2 …

Falls der bei Zeile zwei anfangen soll (Kopfzeile weglassen)

lg OVM

10

um das problemm besser zu erklären I und K sind nicht immer belegt, manchmal nur I oder nur K und die tabelle läuft weiter, also bis die spalte datum leer ist.

hier ist erster code mit do until:
Sub Transfer()
Dim Zeile1 As Integer
Dim Zeile2 As Integer

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

Zeile2 = Zeile2 + 1

End If

Zeile1 = Zeile1 + 1

Loop

End Sub

und hier ist mit for schleife:

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

Zeile1 = 2

For Zeile1 = 1 To 3000
If (Sheets(„5Tage“).Cells(Zeile1, 9).Value „“ Or Sheets(„5Tage“).Cells(Zeile1, 11) „“) Then
Sheets(„Datum1“).Cells(Zeile2, 1) = Sheets(„5Tage“).Cells(Zeile1, 8)
Sheets(„Datum1“).Cells(Zeile2, 2) = Sheets(„5Tage“).Cells(Zeile1, 1)
Sheets(„Datum1“).Cells(Zeile2, 3) = Sheets(„5Tage“).Cells(Zeile1, 2)
Sheets(„Datum1“).Cells(Zeile2, 4) = Sheets(„5Tage“).Cells(Zeile1, 9)
Sheets(„Datum1“).Cells(Zeile2, 5) = Sheets(„5Tage“).Cells(Zeile1, 11)

Zeile2 = Zeile2 + 1

End If

Next Zeile1

End Sub

beide funktionieren nicht, keine Ahnung. kann mir jemand ein rat geben? mit der do until schleife wäre mir verständlicher…

11

Ok ich versuche es noch mal ^^

der Do teil:

do while Sheets(„5Tage“).cells(Zeile1,1).value „“
…
Zeile1 = Zeile1 +1
loop

Es wird geschaut, ob in der Zeile(Zeile1), Spalte(A) ein Wert drin ist. Wenn ja, dann macht der das, was in der do / loop steht.
Wenn kein wert mehr drin steht, dann bricht er ab.
Das heißt, du solltest drauf achten, dass bis zum schluss in spalte A was drin ist. eine einzige leerzeile beendet das Makro.

Dann in der Do/Loop wird geschaut ob in K was drin ist oder in I

If Sheets(„5Tage“).Cells(Zeile1, 9).Value „“ Or Sheets(„5Tage“).Cells(Zeile1, 11) „“ Then
–> Übertrage die Zellen
end if

du kannst auch mal deinen Makrocode schrittweise ausführen. Da siehst du dann, wenn er abbricht. (Im VBA Editor auf deine Routine und mit [F8] starten)
Wenn du mit der maus über die variable hooverst, dann steht auch da immer der aktuelle wert.
oder du baust in in die do/loop noch ein
debug.print zeile1
ein.
Der spuckt dir im direktfenster immer den aktuellen wert für zeile1 aus.

So ich hoffe das war verständlich. Wenn nicht, dann schick mir die xls und ich bastel es schnell selbst zusammen :wink:

lg OVM

12

danke für deine große hilfe!!! ich versuche jetzt selbst was zu basteln wenn es nicht klappt, dann melde ich mich… ich melde mich sowieso…

13

Hallo,

Warum verwendest du dafür nicht einen sverweis?

14

mit sverweis hat es nicht funktioniert, habe mehrmals versucht,

Hallo,

Warum verwendest du dafür nicht einen sverweis?

15

Das würde ich so machen:

Sub CopyData()

 Dim ZeileBlatt1, ZeileBlatt2 As Long

 ZeileBlatt2 = 1 ' Erste zu belegende Zeile in Blatt2
 For ZeileBlatt1 = 1 To 100 ' hier Start- und Endzeile Blatt1 anpassen
 If (Sheets(1).Cells(ZeileBlatt1, 9).Value "") Or (Sheets(1).Cells(ZeileBlatt1, 11).Value "") Then
 Sheets(2).Cells(ZeileBlatt2, 2).Value = Sheets(1).Cells(ZeileBlatt1, 1).Value ' A -\> B
 Sheets(2).Cells(ZeileBlatt2, 3).Value = Sheets(1).Cells(ZeileBlatt1, 2).Value ' B -\> C
 Sheets(2).Cells(ZeileBlatt2, 1).Value = Sheets(1).Cells(ZeileBlatt1, 8).Value ' H -\> A
 Sheets(2).Cells(ZeileBlatt2, 4).Value = Sheets(1).Cells(ZeileBlatt1, 9).Value ' I -\> D
 Sheets(2).Cells(ZeileBlatt2, 5).Value = Sheets(1).Cells(ZeileBlatt1, 11).Value ' K -\> E
 ZeileBlatt2 = ZeileBlatt2 + 1
 End If
 Next

End Sub

Gruß,
BellHouse

16

Hey OVMueller,

es funktioniert, war mein dummer fehler. danke für deine große hilfe!!!

aber ich brächte noch hilfe von deiner seite:

in dieser tabelle sind mehrere spalten mit „datum“ und dazugehörigen artikelmengen, diese subs habe ich in mehreren subs geschrieben, das problem ist jetzt jedes sub muss ich einzeln ausführen. kann man mehrere subs auf ein klick ausführen???

17

Ja,

du schreibst dir ne hauptroutine:

Sub Hauptroutine
call sub1
call sub2
call sub3

(oder auch ohne call einfach den sub namen in die routine schreiben)
end sub

18

Hallo

Tabelle2.Cells(row,col) = Tabelle1.Cells(row1,col1)

Grüsse Sebastian

19

Hallo fwerner
In Access (ich Spezialist für Access VBA)wüsste ich schon wie das funktionieren könnte, leider unterscheidet sich aber Excel VBA im Filezugriff ziemlich von Access VBA. Falls du keine Antwort von einem Excel-Freak erhälst, lass es mich wissen, dann mache ich mich dahinter. Aber lassen wir zuerst Excel Spezialisten ans Werk

Freundliche Grüsse
fonti46

20

Hallo fwerner,

dieser Code erfüllt die Anforderung für eine beliebig lange Artikelliste:

Sub Test()
Sheets(„Tabelle1“).Select
Range(„a2“).Select
zl = 2
Do While ActiveCell.Value „“ 'Abbruch bei erster leerer Zelle in Spalte A
If ActiveCell.Offset(0, 8).Value „“ And ActiveCell.Offset(0, 10).Value „“ Then
artikelnr = ActiveCell.Value
beschreibg = ActiveCell.Offset(0, 1).Value
datum = ActiveCell.Offset(0, 7).Value
menge1 = ActiveCell.Offset(0, 8).Value
menge2 = ActiveCell.Offset(0, 10).Value

Sheets(„Tabelle2“).Select
Cells(zl, 1).Value = datum
Cells(zl, 2).Value = artikelnr
Cells(zl, 3).Value = beschreibg
Cells(zl, 4).Value = menge1
Cells(zl, 5).Value = menge2
zl = zl + 1
End If
Sheets(„Tabelle1“).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Hoffe, das hilft dir weiter.

Gruß
Natator