Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
13.11.2011 15:00:20 |
Sino |
|
|
|
13.11.2011 16:31:13 |
Till |
|
|
|
13.11.2011 17:42:51 |
Sino |
|
|
|
13.11.2011 17:59:47 |
Sino |
|
|
|
13.11.2011 19:32:13 |
Till |
|
|
|
13.11.2011 22:03:30 |
Gast11625 |
|
|
Datensätze kopieren und in neue Datei einfügen |
13.11.2011 22:48:27 |
Till |
|
|
|
14.11.2011 08:28:32 |
Sino |
|
|
|
14.11.2011 08:51:18 |
Sino |
|
|
|
14.11.2011 11:37:01 |
Till |
|
|
|
14.11.2011 13:29:52 |
Sino |
|
|
|
15.11.2011 16:39:12 |
Till |
|
|
|
16.11.2011 12:10:14 |
Gast28616 |
|
|
Von:
Till |
Datum:
13.11.2011 22:48:27 |
Views:
1652 |
Rating:
|
Antwort:
|
Thema:
Datensätze kopieren und in neue Datei einfügen |
Option Explicit
Sub ausschneiden()
Dim intRow As Integer, intLastRow As Integer
Dim ASH As Worksheet, gesamt As Worksheet, unbetrachtet As Worksheet
Dim x As Long, y As Long, lngZeilen As Long
Dim rngZelle As Range
Dim lngAnz As Long
Dim V1, V2
Dim NWB As Workbook 'neues workbook
'Zuweisung der Tabellen zu den Variablen
With ThisWorkbook
Set ASH = .ActiveSheet
Set gesamt = .Worksheets("Gesamtauszug")
End With
'Formeln werden entfernt
For Each rngZelle In ASH.UsedRange
'prüfen ob Zelle eine Formel enthält
If rngZelle.HasFormula = True Then
rngZelle.Rows.Delete
lngAnz = lngAnz + 1
End If
Next rngZelle
'hier wird die länge der Quelltabelle ermittelt und in die Zieltabelle eingef?gt
lngZeilen = gesamt.Cells(gesamt.Rows.Count, 1).End(xlUp).Row
x = 1
'*********************
'*Workbook hinzufügen*
'*********************
Set NWB = Workbooks.Add
With NWB
Set unbetrachtet = .Sheets(1)
.Sheets(1).Name = "unbetrachtete Datensätze"
Application.DisplayAlerts = False
.Sheets(2).Delete
.Sheets(2).Delete
Application.DisplayAlerts = True
End With
'Schleife die die Quelltabelle durchsucht und bei bestimmter Bedingung wird die Aktion copy-paste gestartet
For y = 2 To lngZeilen
'Bedingungen
With gesamt
V1 = .Cells(y, 10)
V2 = .Cells(y, 3).Value
End With
If Not V1 Like "W*" _
Or V2 Like "ROTES*" _
Or V2 Like "TANKK*" _
Or V2 Like "EZW*" _
Or V2 Like "FREMD*" Then
gesamt.Rows(y).Cut unbetrachtet.Rows(x)
x = x + 1
End If
Next y
'************************************
'*neues Workbook speichern/schließen*
'************************************
With NWB
.SaveAs ThisWorkbook.Path & "\Unbetrachtet.xls"
'.Close (False)
End With
'hier werden die leeren Zeilen entfernt
With ASH
intLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If Application.CountA(.Rows(intRow)) = 0 Then
intLastRow = intLastRow - 1
Else
Exit For
End If
Next intRow
For intRow = intLastRow To 1 Step -1
If IsEmpty(.Cells(intRow, 10)) Then
.Rows(intRow).Delete
End If
Next intRow
End With
End Sub
Wenns so immer noch nicht geht dann schreib mal bitte die Fehlermeldung und Fehlerzeile dazu...
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
13.11.2011 15:00:20 |
Sino |
|
|
|
13.11.2011 16:31:13 |
Till |
|
|
|
13.11.2011 17:42:51 |
Sino |
|
|
|
13.11.2011 17:59:47 |
Sino |
|
|
|
13.11.2011 19:32:13 |
Till |
|
|
|
13.11.2011 22:03:30 |
Gast11625 |
|
|
Datensätze kopieren und in neue Datei einfügen |
13.11.2011 22:48:27 |
Till |
|
|
|
14.11.2011 08:28:32 |
Sino |
|
|
|
14.11.2011 08:51:18 |
Sino |
|
|
|
14.11.2011 11:37:01 |
Till |
|
|
|
14.11.2011 13:29:52 |
Sino |
|
|
|
15.11.2011 16:39:12 |
Till |
|
|
|
16.11.2011 12:10:14 |
Gast28616 |
|
|