Zellen in andere Datei kopieren VBA
16.01.2017 07:57:31
Tobias
ich möchte mithilfe eines Makros die Zellinhalte diverser Tabellenblätter kopieren und in eine andere Datei schreiben. Die Zellen auf den Blättern im Bereich(A1:Z100) enthalten alle Formeln, die ich nicht mitkopieren möchte, sondern nur den Inhalt. (Das klappt auch schon ganz gut). Nun möchte ich aber dass die Zellen die "" sind (meine Formeln geben entweder einen Text oder "") nicht mitkopiert werden, sondern wirklich nur die Zellen die einen Text oder eine Zahl oder eine Kombination aus Text und Zahl sind.
ich dachte daran vll die Zellen vorher zu markieren mit .specialCell aber irgendwie kriege ich es nicht hin.
danke im Vorraus und hier mal mein bisheriger Code
Sub Schaltfläche1_Klicken()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim QWB As Workbook, ZWB As Workbook
Dim QWS1 As Worksheet, ZWS1 As Worksheet
Dim QWS2 As Worksheet, ZWS2 As Worksheet
Dim QWS3 As Worksheet, ZWS3 As Worksheet
Dim QWS4 As Worksheet, ZWS4 As Worksheet
Dim QWS5 As Worksheet, ZWS5 As Worksheet
Dim QWS6 As Worksheet, ZWS6 As Worksheet
Dim QWS7 As Worksheet, ZWS7 As Worksheet
Dim QWS8 As Worksheet, ZWS8 As Worksheet
Dim QWS9 As Worksheet, ZWS9 As Worksheet
Dim QWS10 As Worksheet, ZWS10 As Worksheet
Dim QWS11 As Worksheet, ZWS11 As Worksheet
Dim QWS12 As Worksheet, ZWS12 As Worksheet
Dim QWS13 As Worksheet, ZWS13 As Worksheet
Dim QWS14 As Worksheet, ZWS14 As Worksheet
Dim QWS15 As Worksheet, ZWS15 As Worksheet
Dim QWS16 As Worksheet, ZWS16 As Worksheet
Dim QWS17 As Worksheet, ZWS17 As Worksheet
Dim ZWS18 As Worksheet
On Error Resume Next
Set QWB = Workbooks("Makro_Zum_Übertragen.xlsm")
If QWB Is Nothing Then
Set QWB = Workbooks.Open("Pfad...")
End If
Set ZWB = Workbooks("andere_Datei.xlsx")
If ZWB Is Nothing Then
Set ZWB = Workbooks.Open("Pfad...")
End If
On Error GoTo 0
Set QWS1 = QWB.Worksheets("Q1") ' Quelle
Set ZWS1 = ZWB.Worksheets("Z1") ' Ziel
Set QWS2 = QWB.Worksheets("Q2") 'Quelle
Set ZWS2 = ZWB.Worksheets("Z2") 'Ziel
Set QWS3 = QWB.Worksheets("Q3") ' Quelle
Set ZWS3 = ZWB.Worksheets("Z3") ' Ziel
Set ZWS4 = ZWB.Worksheets("Z4") ' Ziel
Set QWS4 = QWB.Worksheets("Q4") ' Quelle
Set QWS5 = QWB.Worksheets("Q5") ' Quelle
Set ZWS5 = ZWB.Worksheets("Z5") ' Ziel
Set ZWS6 = ZWB.Worksheets("Z6") ' Ziel
Set QWS6 = QWB.Worksheets("Q6") ' Quelle
Set QWS7 = QWB.Worksheets("Q7") ' Quelle
Set ZWS7 = ZWB.Worksheets("Z7") ' Ziel
Set ZWS8 = ZWB.Worksheets("Z8") ' Ziel
Set QWS8 = QWB.Worksheets("Q8") ' Quelle
Set QWS9 = QWB.Worksheets("Q9") ' Quelle
Set ZWS9 = ZWB.Worksheets("Z9") ' Ziel
Set ZWS10 = ZWB.Worksheets("Z10") ' Ziel
Set QWS10 = QWB.Worksheets("Q10") ' Quelle
Set QWS11 = QWB.Worksheets("Q11") ' Quelle
Set ZWS11 = ZWB.Worksheets("Z11") ' Ziel
Set ZWS12 = ZWB.Worksheets("Z12") ' Ziel
Set QWS12 = QWB.Worksheets("Q12") ' Quelle
Set ZWS13 = ZWB.Worksheets("Z13") ' Ziel
Set QWS13 = QWB.Worksheets("Q13") ' Quelle
Set ZWS14 = ZWB.Worksheets("Z14") ' Ziel
Set QWS14 = QWB.Worksheets("Q14") ' Quelle
Set ZWS15 = ZWB.Worksheets("Z15") ' Ziel
Set QWS15 = QWB.Worksheets("Q15") ' Quelle
Set ZWS16 = ZWB.Worksheets("Z16") ' Ziel
Set QWS16 = QWB.Worksheets("Q16") ' Quelle
Set ZWS17 = ZWB.Worksheets("Z17") ' Ziel
Set QWS17 = QWB.Worksheets("Q17") ' Quelle
Set ZWS18 = ZWB.Worksheets("Z18") ' Ziel
QWS1.Range("A1:Z201").Copy
ZWS1.Range("A1").PasteSpecial xlPasteValues
QWS2.Range("A1:Z201").Copy
ZWS2.Range("A1").PasteSpecial xlPasteValues
QWS3.Range("A1:Z201").Copy
ZWS3.Range("A1").PasteSpecial xlPasteValues
QWS3.Range("A1:Z201").Copy
ZWS4.Range("A1").PasteSpecial xlPasteValues
QWS4.Range("A1:Z201").Copy
ZWS5.Range("A1").PasteSpecial xlPasteValues
QWS5.Range("A1:Z201").Copy
ZWS6.Range("A1").PasteSpecial xlPasteValues
QWS6.Range("A1:Z201").Copy
ZWS7.Range("A1").PasteSpecial xlPasteValues
QWS7.Range("A1:Z201").Copy
ZWS8.Range("A1").PasteSpecial xlPasteValues
QWS8.Range("A1:Z201").Copy
ZWS9.Range("A1").PasteSpecial xlPasteValues
QWS9.Range("A1:Z201").Copy
ZWS10.Range("A1").PasteSpecial xlPasteValues
QWS10.Range("A1:Z201").Copy
ZWS11.Range("A1").PasteSpecial xlPasteValues
QWS11.Range("A1:Z201").Copy
ZWS12.Range("A1").PasteSpecial xlPasteValues
QWS12.Range("A1:Z201").Copy
ZWS13.Range("A1").PasteSpecial xlPasteValues
QWS13.Range("A1:Z201").Copy
ZWS14.Range("A1").PasteSpecial xlPasteValues
QWS14.Range("A1:Z201").Copy
ZWS15.Range("A1").PasteSpecial xlPasteValues
QWS15.Range("A1:Z201").Copy
ZWS16.Range("A1").PasteSpecial xlPasteValues
QWS16.Range("A1:Z201").Copy
ZWS17.Range("A1").PasteSpecial xlPasteValues
QWS17.Range("A1:Z201").Copy
ZWS18.Range("A1").PasteSpecial xlPasteValues
QWB.Close
ZWB.Save
ZWB.Close
Application.EnableEvents = True
End Sub