2016-12-11 4 views
1

Ich habe Datenbereiche, die sich über mehrere Spalten erstrecken: (C:D), (M:N) und (Q:R). Ich versuche, die erste Reihe in jeder Reihe zu kopieren und sie in ein anderes Blatt einzufügen. Wie in die Bereiche in einen einzigen Bereich kombiniert mit der folgenden SequenzKopieren von Spaltenbereichen in eine einzige Serie in VBA

Die Reihenfolge der Kopie und Einfügen ich zu tun versuche, ist

  1. Erste Reihe von Bereich (C:D)
  2. Erste Reihe von Bereich (M:N)
  3. Erste Reihe des Bereichs (Q:R)
  4. Zweite Reihe von Bereich (C:D)
  5. Zweite Reihe von Bereich (M:N)
  6. Zweite Reihe von Bereich (Q:R)

und dann die dritte Reihe und so weiter .. Ich versuche, die Bereiche in ein anderes Blatt einzufügen.

Bis jetzt habe ich dies getan, indem ich jede Reihe auf einmal kopiere und nacheinander anlege. Aber ich finde es schwierig, dies in eine Schleife umzuwandeln, die eine beliebige Anzahl von Zeilen kopiert und in ein anderes Blatt einfügt.

Sub CopyCol() 

Sheets("Sheet10").Range("C2:D2").Copy 
Sheets("Sheet11").Range("B2:C2").PasteSpecial xlPasteValues 

Sheets("Sheet10").Range("M2:N2").Copy 
Sheets("Sheet11").Range("B3:C3").PasteSpecial xlPasteValues 

Sheets("Sheet10").Range("Q2:R2").Copy 
Sheets("Sheet11").Range("B4:C4").PasteSpecial xlPasteValues 

Sheets("Sheet10").Range("C3:D3").Copy 
Sheets("Sheet11").Range("B5:C5").PasteSpecial xlPasteValues 

Sheets("Sheet10").Range("M3:N3").Copy 
Sheets("Sheet11").Range("B6:C6").PasteSpecial xlPasteValues 

Sheets("Sheet10").Range("Q3:R3").Copy 
Sheets("Sheet11").Range("B7:C7").PasteSpecial xlPasteValues 

... 
End Sub 

Das Kopieren und Einfügen stoppt nicht dort geht es weiter. Ich habe gerade einen Ausschnitt des Codes eingefügt. Die Anzahl der Zeilen in jeder Serie ist 45.

Gibt es eine Möglichkeit, die Anzahl der Zeilen zu reduzieren? Ich konnte nicht herausfinden, wie man es mit einer Schleife macht.

Jede Hilfe oder Vorschläge wäre wirklich hilfreich und sehr geschätzt.

Vielen Dank im Voraus.

Antwort

3

Siehe den folgenden Code - hier die Punkte ist zur Kenntnis zu nehmen:

  • Sie die Folie und Bereichsverweise erstellen (wsSource, rngSource, etc.) und dies verhindert, dass Sie Sheets("Sheet10") ständig beziehen benötigen oder Range("C2:D2") etc - das ist auch eine gute Praxis.

  • können Sie andere Variablen verwenden, um Ihre Bereichsvariablen zu definieren - der Code unten hat zwei Zähler - einen für die 45 Reihen von Quelldaten und einen der Zielzeile in dem anderen Blatt

  • müssen Sie verfolgen zu Schleife durch die Quelldaten, aber Sie nicht eine Schleife durch die Zieldaten, wie Sie auf die gleichen Spalten anhängen B:C und daher nur einen Zeilenzähler Verfolgung Ihrer Position

HTH

Blatt im Ziel benötigen
Sub CopyCol() 

    Dim wsSource As Worksheet 
    Dim wsTarget As Worksheet 

    Dim rngSource As Range 
    Dim rngTarget As Range 

    Dim intSourceRowCounter As Integer 
    Dim intTargetRowCounter As Integer 

    Set wsSource = ThisWorkbook.Worksheets("Sheet10") 
    Set wsTarget = ThisWorkbook.Worksheets("Sheet11") 

    intTargetRowCounter = 1 
    For intSourceRowCounter = 1 To 45 
     Set rngSource = wsSource.Range("C" & intSourceRowCounter & ":" & "D" & intSourceRowCounter) 
     Set rngTarget = wsTarget.Range("B" & intTargetRowCounter & ":" & "C" & intTargetRowCounter) 
     rngTarget.Value = rngSource.Value 
     intTargetRowCounter = intTargetRowCounter + 1 

     Set rngSource = wsSource.Range("M" & intSourceRowCounter & ":" & "N" & intSourceRowCounter) 
     Set rngTarget = wsTarget.Range("B" & intTargetRowCounter & ":" & "C" & intTargetRowCounter) 
     rngTarget.Value = rngSource.Value 
     intTargetRowCounter = intTargetRowCounter + 1 

     Set rngSource = wsSource.Range("Q" & intSourceRowCounter & ":" & "R" & intSourceRowCounter) 
     Set rngTarget = wsTarget.Range("B" & intTargetRowCounter & ":" & "C" & intTargetRowCounter) 
     rngTarget.Value = rngSource.Value 
     intTargetRowCounter = intTargetRowCounter + 1 

    Next intSourceRowCounter 

End Sub 
+0

Vielen Dank für die Antwort, lernte heute eine neue Sache und war wirklich hilfreich :) – Dazzler

Verwandte Themen