Nur bestimmte Zeilen kopieren
Swetlana
kann mir bitte jemand helfen...
Mein folgender Code kopiert mir die kompletten Arbeitsmappen...
Ich würde es aber gerne so haben, dass er mir nur die Zeilen die "P64" enthalten kopiert und in die andere Datei überträgt.....
Was muss ich ändern?
Sub Sammeln1()
Dim FName$, FCount%, R%, c%, nC, i&
Dim Bereich As Range
Dim FileArray()
Dim ProcessCounter As Integer
Application.ScreenUpdating = False
ChDrive "c"
ChDir "C:\Users\slidex\Desktop\Statistiken\Statistiken_neu\KW1"
FName = Dir("*.xls")
Do While FName ""
FCount = FCount + 1
ReDim Preserve FileArray(1 To FCount)
FileArray(FCount) = FName
FName = Dir()
Loop
i = 1
For ProcessCounter = 1 To FCount
Application.DisplayAlerts = False
Workbooks.Open FileArray(ProcessCounter)
On Error Resume Next
R = Cells.Find("*", [A1], , , xlByRows, _
xlPrevious).Row
c = Cells.Find("*", [A1], , , _
xlByColumns, xlPrevious).Column
If Err = 91 Then GoTo WEITER1
Set Bereich = ActiveWorkbook.Worksheets(1) _
.Range(Cells(1, 1), Cells(R, c))
Bereich.Copy Tabelle1.Cells(i, 1)
i = i + R + 1
On Error GoTo 0
WEITER1:
ActiveWorkbook.Close
Application.DisplayAlerts = True
Next ProcessCounter
End Sub