Daten kopieren

Hallo!
Ich möchte von einer Datei1 Daten in eine Arbeitsdatei2 kopieren. Da in der Datei1 mehr drin steht als in Datei2 sollen nur die Daten kopiert werden die ich brauche.
Grundlegend klappt das Kopieren aller Daten. Ich will aber nur die Infos aus z.B. Spalte A bis E, H, K, N, R bis T und W.
Die Daten sollen dann in der neuen Datei ab A2 hintereinander (A bis M) geschrieben werden.
Wünschenswert wäre es wenn Spalte F freigehalten wird da hier eine Formel rein sollte. Eine Berechnung zwischen Spalte D und dem heutigen Datum (=heute()-D2) als Zahl formatiert.
Es sind mehrere Zeilen zu kopieren und die alten Daten in Datei2 sollen überschrieben oder am besten gelöscht werden.
Hier das bisherige Makro:


Sub SMWDatenHolen()
Workbooks.Open Filename:="Datei1.xlsm", UpdateLinks:=0
Sheets("SMW").Select
ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("$A$3:$BN$1146").AutoFilter Field:=2, Criteria1:=Array( _
"FW76921", "FW83778", "FW84118"), Operator:=xlFilterValues
ActiveSheet.Range("a4:e2000", "q4:q2000").Copy
Workbooks("Arbeitsdatei_SMW.xlsm").Activate
Sheets("Eingang").Activate
Range("a2").Select
ActiveSheet.Paste
End Sub

Die Filterung funktioniert soweit und sollte drin bleiben.
Vielleicht kann mir jemand unter die Arme greifen.
Danke.
Markus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten kopieren

26.07.2013 20:29:14

Gerd

Funktioniert. Danke.

30.07.2013 08:43:12

Markus

Sub SMWDatenHolen() Dim wsSource As Worksheet Dim wbTarget As Workbook Dim wsTarget As Worksheet Set wbTarget = Workbooks.Open(Filename:="Datei1.xlsm", UpdateLinks:=0) Set wsSource = Workbooks("Arbeitsdatei_SMW.xlsm").Worksheets("Eingang") Set wsTarget = wbTarget.Worksheets("SMW") wsTarget.UsedRange.Offset(1).Clear With wsSource .AutoFilterMode = False .Range("$A$3:$BN$1146").AutoFilter Field:=2, Criteria1:=Array( _ "FW76921", "FW83778", "FW84118"), Operator:=xlFilterValues With .AutoFilter.Range If .Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then Exit Sub Intersect(.Offset(1), .Parent.Range("A:E")).Copy wsTarget.Cells(2, 1) Intersect(.Offset(1), .Parent.Range("H:H,K:K,N:N,R:T,W:W")).Copy wsTarget.Cells(2, 7) End With End With With wsTarget With .Cells(2, 6).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1) .NumberFormat = "0" .FormulaR1C1 = "=TODAY()-RC4" End With End With End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread