Daten kopieren

Forumthread: Daten kopieren

Daten kopieren

26.07.2013 15:02:39

Markus

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

2
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

AW: Daten kopieren

26.07.2013 20:29:14

Gerd

Hallo 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

Gruß Gerd

Funktioniert. Danke.

30.07.2013 08:43:12

Markus

Hallo Gerd,
ich wollte Dir noch Feedback geben.
Makro funktioniert wunderbar.
Vielen Dank.
Gruß
Markus

Beliebteste Forumthreads (12 Monate)

Forumthread: Daten kopieren

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread