VBA nur 40 gefilterte Zeilen kopieren

dboeb · 11. November 2019 um 21:20

Ich habe eine große Exceltabelle mit Autofilter bearbeitet und habe nun 60 Zeilen. Diese sollen jetzt per Makro in 2 weitere Tabellen kopiert werden, die nur für 40 Zeilen Platz haben. Für alles zum Kopieren habe ich den Code.
Range(„B2“).Select
Range(„B2:H2“).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Der 1.code soll nun von B2:H2 und 40 Zeilen abwärts gehen
Der 2.code soll von Zeile 41 bis ende gehen.

Also die gefilterte Tabelle auf 2 mal Kopiert werden.

Danke dida

Reinhard_fb8cb7 · 11. November 2019 um 21:21

Ich habe eine große Exceltabelle mit Autofilter bearbeitet
und habe nun 60 Zeilen. Diese sollen jetzt per Makro in 2
weitere Tabellen kopiert werden, die nur für 40 Zeilen Platz
haben. Für alles zum Kopieren habe ich den Code.
Der 1.code soll nun von B2:H2 und 40 Zeilen abwärts gehen
Der 2.code soll von Zeile 41 bis ende gehen.

Hallo Dida,

vielleicht so:

Option Explicit

Sub Kopier()
Dim wks2 As Worksheet, wks3 As Worksheet
Set wks2 = Worksheets("Tabelle2")
Set wks3 = Worksheets("Tabelle3")
With Worksheets("Tabelle3")
 Range("B2:H1000").SpecialCells(xlCellTypeVisible).Range("A1:G40").Copy \_
 Destination:=wks2.Range("a1")
 Range("B2:H1000").SpecialCells(xlCellTypeVisible).Range("A41:G60").Copy \_
 Destination:=wks3.Range("a1")
End With
End Sub

Gruß
Reinhard

dboeb · 11. November 2019 um 21:26

Danke Reinhard,

funktioniert hervoragend.
Habe aber noch ein Problem damit.
Da die Tabelle mit Autofilter auf 60 Zeilen reduziert wurde
aber eigentlich 90 Zeilen hat werden die Einträge in den Zeilen 61 bis 90 nicht mit kopiert.
Nun könnte ich es wie folgt einteilen

Range(„B2:H1000“).SpecialCells(xlCellTypeVisible).Range(„A1:G45“).Copy _ Destination:=wks2.Range(„a1“)
Range(„B2:H1000“).SpecialCells(xlCellTypeVisible).Range(„A46:G90“).Copy _ Destination:=wks3.Range(„a1“)

und hoffen, dass in keinem der beiden mehr als 40 Einträge sind.
Gibt es nicht die Möglichkeit das nur die gefilterten und sichtbaren Zeilen kopiert werden.

vielen lieben Dank

dboeb

Reinhard_fb8cb7 · 11. November 2019 um 21:26

Hallo dboeb,

Da die Tabelle mit Autofilter auf 60 Zeilen reduziert wurde
aber eigentlich 90 Zeilen hat werden die Einträge in den
Zeilen 61 bis 90 nicht mit kopiert.

ja.

Nun könnte ich es wie folgt einteilen
Range(„B2:H1000“).SpecialCells(xlCellTypeVisible).Range(„A1:G4
5“).Copy _ Destination:=wks2.Range(„a1“)

Range(„B2:H1000“).SpecialCells(xlCellTypeVisible).Range(„A46:G9
0“).Copy _ Destination:=wks3.Range(„a1“)

Ich weiß grad nicht was vorliegt, du hast schon verstanden daß A1:G45" nicht A1:G45 im Blatt entsprechen?

Die Anzahl der sichtbaren Zeilen kriegste raus mit
msgbox Range(„B2:H91“).SpecialCells(xlCellTypeVisible).rows.count

Gibt es nicht die Möglichkeit das nur die gefilterten und
sichtbaren Zeilen kopiert werden.

?, macht das meine Lösung nicht?
Damit wir vom Gleichen reden, lade mal mit file-upload , s. FAQ:2606 eine Tabelle hoch.

Gruß
Reinhard

dboeb · 11. November 2019 um 21:26

Hallo Reinhard,

der link zur Datei:
http://www.file-upload.net/download-3189969/Mappe1.x…

Die Tabelle ist schon nach Fürth Land gefiltert (blaue Zahlen links.
Wenn ich deinen Code nehme

Range(„B2:H1000“).SpecialCells(xlCellTypeVisible).Range(„A1:G40“).Copy _ Destination:=wks2.Range(„a1“) Range(„B2:H1000“).SpecialCells(xlCellTypeVisible).Range(„A41:G60“).Copy _ Destination:=wks3.Range(„a1“)

Kopiert er die Einträge in der gefilterten Tabelle über 60 nicht mit, daher habe ich ihn in der hochgeladenen Datei schon umgeschrieben.

Kopiert werden nur die sichtbaren. Das ist soweit in Ordnung.
Es werden aber nicht die sichtbaren Zeilen gezählt, sondern alle.
Und hier liegt nun mein Problem. Wenn im Bereich A1:A45( mein neuer Code) mehr als 40 mal Fürth Land vorhanden ist ( die Tabelle ändert sich von Woche zu Woche)kann ich diese nicht mehr in ein forgefertigtes und geschütztes Formular kopieren, da dort nur 40 Zeilen vorhanden sind.

Danke für Deine Bemühungen

dboeb

Reinhard_fb8cb7 · 11. November 2019 um 21:27

http://www.file-upload.net/download-3189969/Mappe1.x…

Hallo dboeb,

okay, klassischer Fehlstart. Aber kriegen wir schon hin, gut daß wir jetzt die gemeinsame Mappe haben.

Ich hab zwar SpezialCells benutzt, hatte auch mit meinen 60 Testzeilen geklappt, aber jetzt mit deinen daten versagt das.

Zum Glück bin ich nicht auf SpecialsCells angewiesen, also löse ich das anders.

Mal eine Frage, kann man deine Anfrage so sehen, du hast in Tab1 irgendwas gefiltert.
In Tab2 möchtest du dann die obersten sichtbaren Zeilen, maximal 40.
Sind es mehr als 40 sollen die anderen nach Tab3.
Kommt es auch vor daß da mehr als 80 sichtbar sind, also Richtung Tab4?

Wenn man deine Anfrage nicht so sehen kann mußte sie mir leider nochmal mit anderen Worten erklären

Gruß
Reinhard

dboeb · 11. November 2019 um 21:27

Hallo Reinhard,

ich habe in Tab1 den Auftrag(Bereich)nach Fürth Land gefiltert.
Deine Frage:
Kommt es auch vor daß da mehr als 80 sichtbar sind, also Richtung Tab4?

Antwort: nein, daß kommt nicht vor.

Bin auf dem VBA Bereich ein zieeeeeeeehhhhhhhhmlicher Anfänger.

Wenn ich den Filter gesetzt habe, habe ich fürs Kopieren aller sichtbaren Zeilen folgenden code:

Range(„B2“).Select
Range(„B2:G2“).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Das Aufteilen in „40 und den Rest“ krieg ich nicht gebacken.

Diesen code wollte ich splitten bis 40 und ab 40

Range(Selection, Selection.End(xlDown))

weis aber nicht wie.

Danke für Deine Geduld

dboeb

Reinhard_fb8cb7 · 11. November 2019 um 21:27

Kommt es auch vor daß da mehr als 80 sichtbar sind, also
Richtung Tab4?
Antwort: nein, daß kommt nicht vor.

Hallo dboeb,

ich hab jetzt Specialfilter rausgeworfen.

Probiers mal so:

Option Explicit

Sub Kopier()
Dim wks2 As Worksheet, wks3 As Worksheet, Zei1 As Long, Zei2 As Long
Dim Z As Long
Set wks2 = Worksheets("Tabelle2")
Set wks3 = Worksheets("Tabelle3")
wks2.UsedRange.ClearContents
wks3.UsedRange.ClearContents
With Worksheets("Tabelle1")
 Zei1 = .Cells(Rows.Count, 1).End(xlUp).Row
 Z = 1
 Do
 Z = Z + 1
 If .Rows(Z).Hidden = False Then
 Zei2 = Zei2 + 1
 .Rows(Z).Copy Destination:=wks2.Cells(Zei2, 1)
 End If
 Loop While Z 

Gruß
Reinhard

dboeb · 11. November 2019 um 21:29

Hallo Reinhard,

vielen Dank für deine Arbeit.
Werde das Makro gleich morgen in der Arbeit ausprobieren.

Gruß dboeb

dboeb · 11. November 2019 um 21:34

Hallo Reinhard,

dein Makro funktioniert wunderbar.
Nachdem ich es zweimal hinereinander im einem anderen Filter laufen lassen will, mußte ich nur die unten fett geschriebenen Anweisungen löschen.

Dim wks2 As Worksheet, wks3 As Worksheet, Zei1 As Long, Zei2
As Long
Dim Z As Long

Ich weis zwar nicht warum und was ich gelöscht habe, aber es LÄUFT.

VIELEN HERLICHEN DANK FÜR DEINE HILFE

Reinhard_fb8cb7 · 11. November 2019 um 21:34

Hallo Dboeb,

dein Makro funktioniert wunderbar.

danke

Nachdem ich es zweimal hinereinander im einem anderen Filter
laufen lassen will, mußte ich nur die unten fett geschriebenen
Anweisungen löschen.

Dim wks2 As Worksheet, wks3 As Worksheet, Zei1 As Long, Zei2
As Long
Dim Z As Long

Das verstehe ich nicht. Sicher, in XL2007/2010 gibt es Sachen, da langt Long nicht mehr, deshalb gibt es da neue Variablentypen.
Aber für Zeilen/Spalten passt Long.

Ich weis zwar nicht warum und was ich gelöscht habe, aber es
LÄUFT.

Zeig mal den jetzigen Gesamtcode, vielleicht erkenne ich was da falsch lief.

Gruß
Reinhard

dboeb · 11. November 2019 um 21:34

Hallo Reinhard,

Nachdem ich es zweimal hinereinander mit einem anderen Filter
laufen lassen will, mußte ich beim code für den zweiten Durchlauf nur die besagten Anweisungen entfernen.

Hier der Code:

Sub Makro1()

’
’ Abrechnung anlegen und Kopieren zuerst in Tabelle 2 und 3 Fürth Land
’ Kriterien

Selection.AutoFilter Field:=5, Criteria1:=„Jobcenter Fürth Land“

'Zählen und bis 25 TN in Tabelle1 den Rest in Tabelle 2

Dim wks2 As Worksheet, wks3 As Worksheet, Zei1 As Long, Zei2 As Long
Dim Z As Long
Set wks2 = Worksheets(„Tabelle2“)
Set wks3 = Worksheets(„Tabelle3“)
wks2.UsedRange.ClearContents
wks3.UsedRange.ClearContents
With Worksheets(„Tabelle1“)
Zei1 = .Cells(Rows.Count, 1).End(xlUp).Row
Z = 1
Do
Z = Z + 1
If .Rows(Z).Hidden = False Then
Zei2 = Zei2 + 1
.Rows(Z).Copy Destination:=wks2.Cells(Zei2, 1)
End If
Loop While Z 'Hier habe ich die Einträge gelöscht

Set wks4 = Worksheets(„Tabelle4“)
Set wks5 = Worksheets(„Tabelle5“)
wks4.UsedRange.ClearContents
wks5.UsedRange.ClearContents
With Worksheets(„Tabelle1“)
Zei1 = .Cells(Rows.Count, 1).End(xlUp).Row
Z = 1
Do
Z = Z + 1
If .Rows(Z).Hidden = False Then
Zei2 = Zei2 + 1
.Rows(Z).Copy Destination:=wks4.Cells(Zei2, 1)
End If
Loop While Z

dboeb · 11. November 2019 um 21:34

Hallo Reinhard,

Zeig mal den jetzigen Gesamtcode

Du wolltest es so ) Hier der Gesamtcode vom ganzen Projekt einer Fahrtkostenabrechnung die sich in den nächsten Jahren x-mal
wiederholt und an der ich immer ca. 3 Stunden sitze.

Sub Makro2()
’
’ Makro2 Makro
’ Makro am 05.01.2011 von Brose aufgezeichnet
’

’
ChDir „C:\Dokumente und Einstellungen\Brose\Desktop\FK“

Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\SC 31319101 § 46_Fahrtkostenabrechnung_ÖNV.xls“
Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\Lau 31319101 § 46_Fahrtkostenabrechnung_ÖNV.xls“
Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\FÜ Stadt 31319101 § 46_Fahrtkostenabrechnung_ÖNV Barauszahlung.xls“
Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\FÜ Land 31319101 § 46_Fahrtkostenabrechnung_ÖNV Barauszahlung.xls“
Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\FÜ Stadt 31319101 § 46_Fahrtkostenabrechnung_ÖNV.xls“
Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\FÜ Stadt 31319101 § 46_Fahrtkostenabrechnung_ÖNV1.xls“
Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\FÜ Land 31319101 § 46_Fahrtkostenabrechnung_ÖNV1.xls“
Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\FÜ Land 31319101 § 46_Fahrtkostenabrechnung_ÖNV.xls“
Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\31319101 Ueberweisungsauftrag § 46 Selbständige.xls“
Workbooks.Open Filename:= _
„C:\Dokumente und Einstellungen\Brose\Desktop\FK\Tabelle für Februar 11 G14-G21.xls“

Windows(„Kopie von Tabelle für xx .xls“).Activate

’ Kopie der Tabelle anlegen und datei schließen

Range(„A2“).Select
Range(„A2:V2“).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(„Tabelle für Februar 11 G14-G21.xls“).Activate
Range(„A2“).Select
ActiveSheet.Paste
Range(„A2“).Select
Rem ActiveWorkbook.Save
Rem ActiveWindow.Close

’ TN mit null Tagen löschen
Windows(„Kopie von Tabelle für xx .xls“).Activate
Selection.AutoFilter Field:=9, Criteria1:=„0“
Range(„B2“).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=9
Range(„B2“).Select

’ Barauszahler anlegen und Kopieren Fürth Stadt

ActiveWindow.ScrollColumn = 13
Selection.AutoFilter Field:=15, Criteria1:="="
Selection.AutoFilter Field:=5, Criteria1:=„Jobcenter Fürth“
ActiveWindow.ScrollColumn = 4
Range(„B2“).Select
Range(„B2:H2“).Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Copy
Windows(„FÜ Stadt 31319101 § 46_Fahrtkostenabrechnung_ÖNV Barauszahlung.xls“) _
.Activate
Range(„B6“).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Windows(„Kopie von Tabelle für xx .xls“).Activate
Range(„I2“).Select
Range(„I2:L2“).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows(„FÜ Stadt 31319101 § 46_Fahrtkostenabrechnung_ÖNV Barauszahlung.xls“) _
.Activate
Range(„N6“).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range(„B6“).Select
Rem ActiveWorkbook.Save
Rem ActiveWindow.Close

Windows(„Kopie von Tabelle für xx .xls“).Activate
ActiveWindow.ScrollColumn = 13
Selection.AutoFilter Field:=15
Selection.AutoFilter Field:=5
ActiveWindow.ScrollColumn = 4
Range(„B2“).Select

’ Barauszahler anlegen und Kopieren Fürth Land
’ Kriterien

ActiveWindow.ScrollColumn = 13
Selection.AutoFilter Field:=15, Criteria1:="="
Selection.AutoFilter Field:=5, Criteria1:=„Jobcenter Fürth Land“

’ Kopiervorgang

ActiveWindow.ScrollColumn = 4
Range(„B2“).Select
Range(„B2:H2“).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Windows(„FÜ Land 31319101 § 46_Fahrtkostenabrechnung_ÖNV Barauszahlung.xls“) _
.Activate
Range(„B6“).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows(„Kopie von Tabelle für xx .xls“).Activate
Range(„I2“).Select
Range(„I2:L2“).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

Windows(„FÜ Land 31319101 § 46_Fahrtkostenabrechnung_ÖNV Barauszahlung.xls“) _
.Activate
Range(„N6“).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range(„B6“).Select
Rem ActiveWorkbook.Save
Rem ActiveWindow.Close

’ Kriterien zurücksetzen

Windows(„Kopie von Tabelle für xx .xls“).Activate
Selection.AutoFilter Field:=15
Selection.AutoFilter Field:=5
Range(„B2“).Select

’ Überweisungsträger kopieren

Selection.AutoFilter Field:=15, Criteria1:=""
Range(„M2“).Select
Range(„M2:V2“).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(„31319101 Ueberweisungsauftrag § 46 Selbständige.xls“).Activate
Range(„B7“).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range(„B7“).Select
Rem ActiveWorkbook.Save
Rem ActiveWindow.Close

Windows(„Kopie von Tabelle für xx .xls“).Activate
Selection.AutoFilter Field:=15
Range(„B2“).Select

’ TN mit ohne Konto löschen

Selection.AutoFilter Field:=15, Criteria1:="="
Range(„B2“).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=15
Range(„B2“).Select

’ Kontobereich loschen

Range(„M2:V2“).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete
Range(„B2“).Select

’ Abrechnung anlegen und Kopieren Schwabach
’ Kriterien

Selection.AutoFilter Field:=5, Criteria1:=„Jobcenter Schwabach“

’ Kopiervorgang

Range(„B2“).Select
Range(„B2:H2“).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Windows(„SC 31319101 § 46_Fahrtkostenabrechnung_ÖNV.xls“) _
.Activate
Range(„B6“).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows(„Kopie von Tabelle für xx .xls“).Activate
Range(„I2“).Select
Range(„I2:L2“).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

Windows(„SC 31319101 § 46_Fahrtkostenabrechnung_ÖNV.xls“) _
.Activate
Range(„N6“).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range(„B6“).Select
Rem ActiveWorkbook.Save
Rem ActiveWindow.Close

’ Kriterien zurücksetzen

Windows(„Kopie von Tabelle für xx .xls“).Activate
Selection.AutoFilter Field:=5
Range(„B2“).Select

’ Abrechnung anlegen und Kopieren Lauf
’ Kriterien

Selection.AutoFilter Field:=5, Criteria1:=„Jobcenter Nbg. Land“

’ Kopiervorgang

Range(„B2“).Select
Range(„B2:H2“).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Windows(„LAU 31319101 § 46_Fahrtkostenabrechnung_ÖNV.xls“) _
.Activate
Range(„B6“).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Windows(„Kopie von Tabelle für xx .xls“).Activate
Range(„I2“).Select
Range(„I2:L2“).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

Windows(„LAU 31319101 § 46_Fahrtkostenabrechnung_ÖNV.xls“) _
.Activate
Range(„N6“).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range(„B6“).Select
Rem ActiveWorkbook.Save
Rem ActiveWindow.Close

’ Kriterien zurücksetzen

Windows(„Kopie von Tabelle für xx .xls“).Activate
Selection.AutoFilter Field:=5
Range(„B2“).Select

’ Abrechnung anlegen und Kopieren zuerst in Tabelle 2 und 3 Fürth Land
’ Kriterien

Selection.AutoFilter Field:=5, Criteria1:=„Jobcenter Fürth Land“

'Zählen und bis 25 TN in Tabelle1 den Rest in Tabelle 2

Dim wks2 As Worksheet, wks3 As Worksheet, Zei1 As Long, Zei2 As Long
Dim Z As Long
Set wks2 = Worksheets(„Tabelle2“)
Set wks3 = Worksheets(„Tabelle3“)
wks2.UsedRange.ClearContents
wks3.UsedRange.ClearContents
With Worksheets(„Tabelle1“)
Zei1 = .Cells(Rows.Count, 1).End(xlUp).Row
Z = 1
Do
Z = Z + 1
If .Rows(Z).Hidden = False Then
Zei2 = Zei2 + 1
.Rows(Z).Copy Destination:=wks2.Cells(Zei2, 1)
End If
Loop While Z Copy Destination:=wks4.Cells(Zei2, 1)
End If
Loop While Z

Beim kopieren in Tabelle 4 fängt er aus mir unerfindlichen Gründen bei A4 an Statt bei A1. Alle anderen sind A1!!!
Kann aber damit leben, wird halt ab B4 kopiert.

Viel Spaß wünsch der Dilettant

Dietrich

Reinhard_fb8cb7 · 11. November 2019 um 21:35

Hallo Dietrich,

Du wolltest es so ) Hier der Gesamtcode vom ganzen Projekt
einer Fahrtkostenabrechnung die sich in den nächsten Jahren
x-mal
wiederholt und an der ich immer ca. 3 Stunden sitze.

warum sitzt du da immer 3 Stunden, dafür ist doch Vba da um das zu verkürzen?

Zum Code. Zunächst mal, alle Dim gehören oben hin. Sie werden sowieso vom Debugger zuerst kopmpiliert bevor der Restcode dann interpretiert wird.

Du hast im Code 250 mal Select und Activate drinnen, brauchen tust du das vielleicht 1-2 mal.

Windows(„Kopie von Tabelle für xx .xls“).Activate
hast du so 20 mal im Code, unnötig.
Die ganzen Mappenöffnungen würd ich in eine eigene Sub auslagern.

Deine Sub sähe dann so aus:

Sub Makro2()
Dim wks1 As Worksheet, wks2 As Worksheet
ChDir "C:\Dokumente und Einstellungen\Brose\Desktop\FK"
Call OeffneMappe
With Workbooks("Kopie von Tabelle für xx .xls").Worksheets("Tabelle1")
 Set wks1 = Workbooks("Tabelle für Februar 11 G14-G21.xls").Worksheets("Tabelle1")
 .Range("A2:V" & Rows.Count).Copy Destination:=wks1.Range("A2")
 '
 'dein sonstiger Code
 '
End With
End Sub

Das ersetzt deinen Codebeginn einschließlich:
Range(„A2“).Select
Range(„A2:V2“).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(„Tabelle für Februar 11 G14-G21.xls“).Activate
Range(„A2“).Select
ActiveSheet.Paste

Beim kopieren in Tabelle 4 fängt er aus mir unerfindlichen
Gründen bei A4 an Statt bei A1. Alle anderen sind
A1!!!

Soweit kam ich noch nicht, korrigier erstmal den Code daß er überhaupt lesbar wird.

Gruß
Reinhard