Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 12:58:59
Daten einfügen aus anderem Sheet
19.04.2024 12:23:24
Wenn-Formel anpassen
19.04.2024 12:09:19
Unique (Application.WorksheetFunction.Unique)
19.04.2024 11:51:37
Nächsten identischen Treffer suchen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1268to1272
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1268to1272
1268to1272
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bereich kopieren

Bereich kopieren
Horst

Hallo Excel-Experten!
Ein Problem, dass bis dato noch keiner richtig lösen konnte ...
Wie kann ich im folgenden Makro angeben, dass nach dem Setzen des Autofilters nicht das gesamte Blatt, sondern ausschließlich die Spalten $A$ bis $DT$ kopiert werden?
Probiert habe ich bereits "Intersect(.UsedRange, .Range("A:DT")).copy tmpWS.Cells(1, 1)" sowie "Range(Columns(31), Columns(Columns.Count)).Delete", beides allerdings ohne Erfolg.
Wäre toll, wenn jemand Bescheid wüsste,
Gruß, Horst
Sub (Makro1)
With oWB_Ex
Set tmpWS = .Sheets.Add
With .Sheets("results")
.UsedRange.AutoFilter Field:=134, Criteria1:="1"
.UsedRange.AutoFilter Field:=126, Criteria1:=" 1 Then
With Application
F = FreeFile
Open File_Test For Append As #F
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))), vbTab)
Print #F, sString
Close #F
strInfo$ = Chr(149) & " " & Mid$(File_Test, InStrRev(File_Test, "\") + 1, Len(File_Test) _
_
) & vbCr
lngMaxRow = lngMaxRow - 1
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Bereich kopieren
28.06.2012 17:14:39
Luschi
Hallo Horst,
versuch es mal so: 

Sub test()
Dim rg As Range
Dim s As String
If ActiveSheet.AutoFilterMode Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.Cursor = xlWait
'alle sichtbaren Zellen des aktiven Autofilters als Range-Bereich
Set rg = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
'Adressen der sichtbaren Zellen im Autofilter
s = rg.Address
'letzte Spalte hier: 'GH' gegen 'DT' austauschen
s = Replace(s, "$GH$", "$DT$", 1, -1, vbTextCompare)
'Kopierbereich neu definieren
Set rg = ActiveSheet.Range(s)
'Bereich kopieren
rg.Copy
'andere Tabelle auswählen
Tabelle2.Select
'StartZelle auswählen
Tabelle2.Range("B10").Select
'Kopieren
Tabelle2.Paste
'Kopiermodis deaktivieren
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Cursor = xlWait
End If
Set rg = Nothing
End Sub
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Bereich kopieren
28.06.2012 23:24:45
Dieter
Hallo Luschi,
danke für deinen Code, aber ich hätte eigentlich gedacht, dass man mit ein, zwei Zeilen den Bereich A:DT in meiner VBA-Prozedur einschränken kann. Glaubst du, ist das möglich? Es geht um große .xls mit ein paar hundert MB und es soll möglichst wenig Rechenzeit bei dem Vorgang benötigt werden.
Besten Dank vorab!
Horst
Sub (Makro1)
With oWB_Ex
Set tmpWS = .Sheets.Add
With .Sheets("results")
.UsedRange.AutoFilter Field:=134, Criteria1:="1"
.UsedRange.AutoFilter Field:=126, Criteria1:=" 1 Then
With Application
F = FreeFile
Open File_Test For Append As #F
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))), vbTab)
Print #F, sString
Close #F
strInfo$ = Chr(149) & " " & Mid$(File_Test, InStrRev(File_Test, "\") + 1, Len(File_Test) _
_
_
) & vbCr
lngMaxRow = lngMaxRow - 1
End Sub

Anzeige
AW: Bereich kopieren
28.06.2012 23:27:37
Horst
Hallo Luschi,
danke für deinen Code, aber ich hätte eigentlich gedacht, dass man mit ein, zwei Zeilen den Bereich A:DT in meiner VBA-Prozedur einschränken kann. Glaubst du, ist das möglich? Es geht um große .xls mit ein paar hundert MB und es soll möglichst wenig Rechenzeit bei dem Vorgang benötigt werden.
Besten Dank vorab!
Horst
Sub (Makro1)
With oWB_Ex
Set tmpWS = .Sheets.Add
With .Sheets("results")
.UsedRange.AutoFilter Field:=134, Criteria1:="1"
.UsedRange.AutoFilter Field:=126, Criteria1:=" 1 Then
With Application
F = FreeFile
Open File_Test For Append As #F
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))), vbTab)
Print #F, sString
Close #F
strInfo$ = Chr(149) & " " & Mid$(File_Test, InStrRev(File_Test, "\") + 1, Len(File_Test) _
_
_
) & vbCr
lngMaxRow = lngMaxRow - 1
End Sub

Anzeige
AW: Bereich kopieren
29.06.2012 00:35:36
Raphael
Hallo Horst,
ich würde mich nicht Experte nennen, aber für deinen Fall hätte ich glaube ich eine einfache und praktische Lösung.
.....
with .sheets("result")
.UsedRange.Columns.Hidden = true
....... deinen autofilter setzen
.columns("A:DT").hidden = false
.Range("A1").CurrentRegion.SpecialCells(xlVisible).Copy _
ZIELSHEETANGEBEN.Range("A1")
.usedrange.columns.hidden = false
end with
..............
Ich bin nicht sicher, aber wenn ich deinen Problembeschrieb richtig verstanden habe, müsste das eigentlich problemlos funktionieren.
AW: Bereich kopieren
29.06.2012 18:11:47
Horst
Raphael,
einfach großartig! Oft sind die einfachen Lösungen doch die besten. Es funktioniert!
Tausend Dank nochmal!
Gruß, Horst
Anzeige
AW: Bereich kopieren
29.06.2012 21:26:32
Raphael
Bitte

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige