web-dev-qa-db-de.com

Bereich kopieren und Werte in den spezifischen Bereich eines anderen Arbeitsblatts einfügen

Ich versuche, ein Excel-Makro zum Laufen zu bringen, aber ich habe ein Problem mit dem Kopieren der Werte aus Formel enthaltenden Zellen.

Bisher habe ich dies und es funktioniert gut mit den Zellen ohne Formel.

Sub Get_Data()
Dim lastrow As Long

lastrow = Sheets("DB").Range("A65536").End(xlUp).Row + 1

Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow)
Range("C3:C65536").Copy Destination:=Sheets("DB").Range("A" & lastrow)
Range("D3:D65536").Copy Destination:=Sheets("DB").Range("C" & lastrow)
Range("E3:E65536").Copy Destination:=Sheets("DB").Range("P" & lastrow)
Range("F3:F65536").Copy Destination:=Sheets("DB").Range("D" & lastrow)
Range("AH3:AH65536").Copy Destination:=Sheets("DB").Range("E" & lastrow)
Range("AIH3:AI65536").Copy Destination:=Sheets("DB").Range("G" & lastrow)
Range("AJ3:AJ65536").Copy Destination:=Sheets("DB").Range("F" & lastrow)
Range("J3:J65536").Copy Destination:=Sheets("DB").Range("H" & lastrow)
Range("P3:P65550").Copy Destination:=Sheets("DB").Range("I" & lastrow)
Range("AF3:AF65536").Copy Destination:=Sheets("DB").Range("J" & lastrow).

End Sub

Wie kann ich es so machen, dass die Werte eingefügt werden?

Wenn dies geändert/optimiert werden kann, würde ich es auch schätzen.

10
BlueSun3k1

Du kannst ändern

Range("B3:B65536").Copy Destination:=Sheets("DB").Range("B" & lastrow)

zu

Range("B3:B65536").Copy 
Sheets("DB").Range("B" & lastrow).PasteSpecial xlPasteValues

Übrigens, wenn Sie eine xls-Datei (Excel 2003) haben, erhalten Sie eine Fehlermeldung, wenn Ihre lastrow größer 3 wäre.

Versuchen Sie stattdessen diesen Code zu verwenden:

Sub Get_Data()
    Dim lastrowDB As Long, lastrow As Long
    Dim arr1, arr2, i As Integer

    With Sheets("DB")
        lastrowDB = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With

    arr1 = Array("B", "C", "D", "E", "F", "AH", "AI", "AJ", "J", "P", "AF")
    arr2 = Array("B", "A", "C", "P", "D", "E", "G", "F", "H", "I", "J")

    For i = LBound(arr1) To UBound(arr1)
        With Sheets("Sheet1")
             lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
             .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
             Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
        End With
    Next
    Application.CutCopyMode = False
End Sub

Der obige Code bestimmt die letzte nicht leere Zeile in DB in Spalte A (Variable lastrowDB). Wenn Sie für jede Zielspalte in DB eine letzte Zeile suchen müssen, verwenden Sie die nächste Änderung:

For i = LBound(arr1) To UBound(arr1)
   With Sheets("DB")
       lastrowDB = .Cells(.Rows.Count, arr2(i)).End(xlUp).Row + 1
   End With

   ' NEXT CODE

Next

Sie können stattdessen auch den nächsten Ansatz Copy/PasteSpecial verwenden. Ersetzen

.Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
Sheets("DB").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues

mit

Sheets("DB").Range(arr2(i) & lastrowDB).Resize(lastrow - 2).Value = _
      .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Value
21
Dmitry Pavliv

Wie wäre es, wenn Sie jede Spalte in einem Arbeitsblatt auf andere Arbeitsblätter kopieren? Beispiel: Zeile B des MySheet zu Zeile B des Arbeitsblatts1, Zeile C des MySheet zu Zeile B des Arbeitsblatts 2 ...

0
Gem