PDA

Vollständige Version anzeigen : Inhalte kopieren


retaster
07.05.2009, 12:26
Hallo allerseits,

ich habe der Einfachheit wegen eine Datei angehängt.
Ich möchte gern die Daten in den gelb markierten Bereichen in den orange markierten Bereich des nächsten Blattes kopieren lassen. Die evtl. entstehenden Leerzeilen sollen danach gelöscht werden, ebenso soll bei jedem Makroaufruf der orange markierte Bereich vorher gelöscht werden.

Für Hilfe bin ich dankbar
Gruss
Stephan

Backowe
07.05.2009, 12:52
Hi Stephan,

setz Dir einen Commandbutton auf das Mastersheet und kopiere folgenden Code hinein:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Private Sub</span> CommandButton1_Click()
<span class="TOKEN">With</span> Sheets(&quot;Changes&quot;)
.Range(&quot;A6:G&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row).ClearContents
Range(&quot;E11:K20&quot;).Copy
.Range(&quot;A6&quot;).PasteSpecial xlPasteValues
Application.CutCopyMode = <span class="TOKEN">False</span>
<span class="TOKEN">If</span> Application.CountBlank(.Range(&quot;A6:A&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row)) &gt; 0 <span class="TOKEN">Then</span>
.Range(&quot;A6:A&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Delete
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)

retaster
07.05.2009, 13:13
Hallo Jürgen,

danke erstmal, aber leider werden nur die Daten aus dem ersten gelben Bereich kopiert, ich brauch aber alle Daten aus allen gelben Bereichen.

Gruss

Backowe
07.05.2009, 13:30
Hi Stephan,

war mir nicht aufgefallen, daß weiter unten noch was steht! Sorry! ;)

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Private Sub</span> CommandButton1_Click()
Application.ScreenUpdating = <span class="TOKEN">False</span>
<span class="TOKEN">With</span> Sheets(&quot;Changes&quot;)
.Range(&quot;A6:G&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row).ClearContents
&nbsp;
Range(&quot;E11:K20&quot;).Copy
.Range(&quot;A6&quot;).PasteSpecial xlPasteValues
&nbsp;
Range(&quot;E42:K51&quot;).Copy
.Range(&quot;A&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row + 1).PasteSpecial xlPasteValues
&nbsp;
Range(&quot;E64:K73&quot;).Copy
.Range(&quot;A&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row + 1).PasteSpecial xlPasteValues
&nbsp;
Range(&quot;E97:K106&quot;).Copy
.Range(&quot;A&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row + 1).PasteSpecial xlPasteValues
&nbsp;
Range(&quot;E118:K127&quot;).Copy
.Range(&quot;A&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row + 1).PasteSpecial xlPasteValues
&nbsp;
Application.CutCopyMode = <span class="TOKEN">False</span>
&nbsp;
<span class="TOKEN">If</span> Application.CountBlank(.Range(&quot;A6:A&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row)) &gt; 0 <span class="TOKEN">Then</span>
.Range(&quot;A6:A&quot; &amp; .Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Delete
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
Application.ScreenUpdating = <span class="TOKEN">True</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)

Backowe
07.05.2009, 14:02
Hi Stephan,

noch eine kleine Fehlerberichtugung, da hat noch etwas gefehlt:

.Range("A6:A" & .Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete