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

Makro: kopieren

Makro: kopieren
02.01.2006 12:56:35
Daniel
Hallo!
Ich habe nochmal eine Bitte für ein Makro:
Ich muss aus dem Blatt "Bericht_Daten" die Inhalte der Spalten B,D,E unf F nach den Spalten J,K,L und M des Blatts "Bericht" kopieren.
Das umständliche ist, dass nur dann die Werte kopiert werden dürfen, wenn im Blatt "Bericht_Daten" in Spalte A etwas steht.
Der Kopiervorgang soll zudem alphabetisch sein, aber das sollte ich inzwischen selbst per Makro hinbekommen.
Für hilfe wäre ich dankbar,
Daniel

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro: kopieren
02.01.2006 13:29:59
Eugen
hi
Public

Sub copy()
Sheets("Bericht").Cells.ClearContents
nRow = 1
For i = 1 To Sheets("Bericht_Daten").UsedRange.Rows.Count
If Sheets("Bericht_Daten").Cells(i, 1).Value <> "" Then
Sheets("Bericht").Cells(nRow, 10).Value = Sheets("Bericht_Daten").Cells(i, 2).Value
Sheets("Bericht").Cells(nRow, 11).Value = Sheets("Bericht_Daten").Cells(i, 4).Value
Sheets("Bericht").Cells(nRow, 12).Value = Sheets("Bericht_Daten").Cells(i, 5).Value
Sheets("Bericht").Cells(nRow, 13).Value = Sheets("Bericht_Daten").Cells(i, 6).Value
nRow = nRow + 1
End If
Next i
End Sub

mfg
Anzeige
AW: Makro: kopieren
02.01.2006 13:39:07
Daniel
Zunächst danke.
Der ganze Blattinhanlt von bericht darf nicht gelöscht werden....nur J,K,L und M.
Danach kann ich erst stehen, ob das alles so richtig ist.
Danke,
Daniel
AW: Makro: kopieren
02.01.2006 14:17:28
Eugen
hi
dann ersetze die zeiel mit dem clearcontents
mit folgendem
for i = 10 to 13
sheets(1).Column(i).delete
next i
mfg
AW: Makro: kopieren
02.01.2006 14:24:43
Daniel
Hallo Eugen,
das klappt irgendwie nicht. Sheets...wird gelb markiert.
Geht es außerdem, dass die erste Zeile erhalten bleibt?
Grüße,
Daniel
AW: Makro: kopieren
02.01.2006 14:41:25
Eugen
hi
dann probier mal das.
nfRow = 2 ' ab der zweiten zeile
nlRow = sheets("Bericht").usedrange.rows.count ' letzte benutzte zeile
sheets("Bericht").range(sheets("Bericht").cells(nlRow,10), _
sheets("Bericht").Cells(mlRow,13)).delete
so sollte es funzen
mfg
Anzeige
AW: Makro: kopieren
02.01.2006 14:48:22
Daniel
Hi,
Anwendungs- oder objektidefnierter fehler:
sheets("Bericht").range(sheets("Bericht").cells(nlRow,10), _
sheets("Bericht").Cells(mlRow,13)).delete
was mache ich falsch?
Daniel
AW: Makro: kopieren
02.01.2006 15:45:22
Eugen
hi
lade die datei mal auf den server..
das kann nicht mehr viel sein.
mfg
AW: Makro: kopieren
02.01.2006 17:20:53
Daniel
Hi, ich habe es inzwischen selbst geschafft mit Hilfe eines anderen Makros in einer anderen Datei. Hatte mich erinnert, dass ein teil ähnlich war mit dem Spalten löschen.
Danke für die Hilfe!!!
Hier noch der Code:

Sub copy()
Const EZ = 2
Set sh = Sheets("Bericht")
Application.ScreenUpdating = False
With sh
sh.Range(.Cells(EZ, 10), .Cells(.Rows.Count, 10)).ClearContents
sh.Range(.Cells(EZ, 11), .Cells(.Rows.Count, 11)).ClearContents
sh.Range(.Cells(EZ, 12), .Cells(.Rows.Count, 12)).ClearContents
sh.Range(.Cells(EZ, 13), .Cells(.Rows.Count, 13)).ClearContents
End With
nRow = 2
For i = 18 To Sheets("Bericht_Daten").UsedRange.Rows.Count
If Sheets("Bericht_Daten").Cells(i, 1).Value <> "" Then
Sheets("Bericht").Cells(nRow, 10).Value = Sheets("Bericht_Daten").Cells(i, 2).Value
Sheets("Bericht").Cells(nRow, 11).Value = Sheets("Bericht_Daten").Cells(i, 4).Value
Sheets("Bericht").Cells(nRow, 12).Value = Sheets("Bericht_Daten").Cells(i, 5).Value
Sheets("Bericht").Cells(nRow, 13).Value = Sheets("Bericht_Daten").Cells(i, 6).Value
nRow = nRow + 1
End If
Next i
Sheets("Bericht").Select
Columns("J:M").Select
Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige