saphire
Goto Top

Range eines Arbeitsblattes definieren ??

Liebe Leute,

bitte um eure Hilfe bezüglich der untenstehenden Makro. Diese Makro funktioniert zwar, nur werden die Arbeitsblætter nicht vollstændig kopiert.
Bitte um Erweiterungsvorschlæge für diese Makro mit der folgenden Kriterie.

1) Die Tabelle soll angefangen von A4 bis F4 und nach unten bis zur letzten reihe im A bis F kopiert werden.


Private Sub Workbook_Open()
Dim trz As Integer
Dim sayToplam As Integer
Dim i As Integer
Sheets("yedek").Range("A1:LA65536").ClearContents
For i = 1 To 2 'sayfa sayısı
trz = WorksheetFunction.CountA(Worksheets(Worksheets(i).Name).Range("A4:F4"))
sayToplam = WorksheetFunction.CountA(Worksheets("yedek").Range("A:A"))
Worksheets(Worksheets(i).Name).Range("A4:F" & trz).Copy _
Worksheets("yedek").Range("A" & sayToplam + 1)
Next i

End Sub


Danke im Voraus für eure Bemühungen und Lösungsvorschlæge.

Lg.
Ali

Content-Key: 265546

Url: https://administrator.de/contentid/265546

Printed on: April 19, 2024 at 21:04 o'clock

Mitglied: 114757
114757 Mar 07, 2015 updated at 12:24:04 (UTC)
Goto Top
With Worksheets(Worksheets(i).Name)
    .Range("A4:F" & .Cells(Rows.Count,1).End(xlUp).Row).Copy Worksheets("yedek").Range("A" & Worksheets("yedek").Cells(Rows.Count,1).End(xlUp).Row +1)  
End with
Gruß jodel32

p.s. hatten wir gerade schon hier:
Bereich Markieren und Kopieren (Verständnis)
Member: Saphire
Saphire Mar 07, 2015 at 12:40:44 (UTC)
Goto Top
Hallo jodel32,

danke sehr für die rasche Antwort, bekomme jetzt die Meldung Runtime error 438 Object does not support this property or method

Wie kann ich hier am besten vorgehen, tut mir sehr leid für diese Fragen aber kenn mich mit VBA überhaupt nicht aus.

Lg
Ali
Mitglied: 114757
114757 Mar 07, 2015 updated at 15:30:33 (UTC)
Goto Top
Also, Ali von'e schleuse ...
Geht problemlos wenn man es denn richtig anwendet face-wink
Hier mal dein gebümmsel optimiert ....
Private Sub Workbook_Open()
    Dim wsTarget as Worksheet
     ' Zielsheet definieren  
    set wsTarget = Worksheets("yedek")  
    ' Inhalt des Zielsheets löschen  
    wsTarget.UsedRange.Clear
    ' Inhalte der Ranges A4:Fx von Sheets 1-2 ins Zielsheet untereinander kopieren  
    For i = 1 To 2
        With Worksheets(i)
            .Range("A4:F" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy Destination:=wsTarget.Cells(wsTarget.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1)  
        End with
End Sub
Gruß jodel32

tut mir sehr leid für diese Fragen aber kenn mich mit VBA überhaupt nicht aus.
Wie wärs dann mal mit einem Kurs für die Grundlagen ?!
http://de.m.wikibooks.org/wiki/VBA_in_Excel
http://www.herber.de/mailing/Die_letzte_Zeile_des_aktiven_Blattes_in_an ...
Member: Saphire
Saphire Mar 07, 2015 at 14:10:33 (UTC)
Goto Top
Hallo jodel32,

danke sehr für dıe links, werde mich dem widmen.

die Makro funktioniert zwar, nur wird beım ersten arbeitsblatt nur die erste Zeile genommen, das zweitte Arbeitsblatt wird aber vollstændig übernommen. (Optimal wære auch die formatierung der kopierten Tabellen zu übernehmen.)

so schaut sie bei mir nun aus.

Private Sub Workbook_Open()
Dim wsTarget As Worksheet
' Zielsheet definieren
Set wsTarget = Worksheets("yedek")
' Inhalt des Zielsheets löschen
wsTarget.UsedRange.ClearContents
' Inhalte der Ranges A150:Fx von Sheets 1-2 ins Zielsheet untereinander kopieren
For i = 1 To 2
With Worksheets(i)
.Range("A150:F" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

Next i

End Sub

Lg
ali
Mitglied: 114757
114757 Mar 07, 2015 updated at 14:24:29 (UTC)
Goto Top
die Makro funktioniert zwar, nur wird beım ersten arbeitsblatt nur die erste Zeile genommen
Wo ist denn auf dem ersten Blatt in Spalte A die letzte Zelle mit einem Wert ? Wenn in Spalte A nur ein Wert in Zeile 150 steht und darunter nichts mehr kommt dann wäre das Verhalten klar.
Willst du die Absolut letzte belegte Zeile des Blattes ermitteln, egal ob in Spalte A nach Zeile 150 ein Wert kommt oder nicht, machst du das mit
.Range("A150:F" & .UsedRange.Rows.Count).Copy wsTarget.Cells(Rows.Count,1).End(xlUp).Offset(1,0)   
im obigen Code

p.s. Bitte nutze endlich die Code Formatierung !!!!!!!!!
Member: Saphire
Saphire Mar 07, 2015 at 14:43:09 (UTC)
Goto Top
Die Inhalte des zweitten Arbeitsblattes werden komplett übernommen, die Inhalte des ersten Arbeitsblattes werden mit der letzten ænderung aber gar nicht übernommen. Ich glaube, dass ich mich am Anfang nicht genau ausgedrückt habe. İch habe ca. 1200 Arbeitsblætter die ich untereinander kopieren muss um im Target Arbeitsblatt die Daten zu filtern.

Lg
Ali
Mitglied: 114757
114757 Mar 07, 2015 updated at 14:48:03 (UTC)
Goto Top
Zitat von @Saphire:
Die Inhalte des zweitten Arbeitsblattes werden komplett übernommen, die Inhalte des ersten Arbeitsblattes werden mit der
letzten ænderung aber gar nicht übernommen. Ich glaube, dass ich mich am Anfang nicht genau ausgedrückt habe. İch
habe ca. 1200 Arbeitsblætter die ich untereinander kopieren muss um im Target Arbeitsblatt die Daten zu filtern.

Und wieso hast du dann die Schleife dann nur von 1 -2 definiert ?? Kopfschüttel !
An welcher Poition liegt dein Zielsheet ?
Leider bringst du hier zu wenig Infos aus deinen Sheets ....
Member: Saphire
Saphire Mar 07, 2015 at 14:51:53 (UTC)
Goto Top
İch habe nur einen Testfile genommen mit 4 sheets um es auszuprobieren,

im Testfile liegt sie an 5 ter Stelle (letztes Blatt)

habe davor 4 sheets deren İnhalte ich ab der A4 zelle bis F und nach unten bis zur letzten zeile kopieren muss,

die Inhalte sind leider nicht als Tabelle formatiert aber sie besitzen eine bestimmte Formatierung. Wenn möglich würde ich sie mit diesem Format übernehmen wollen.
Mitglied: 114757
Solution 114757 Mar 07, 2015 updated at 15:48:39 (UTC)
Goto Top
die Inhalte sind leider nicht als Tabelle formatiert aber sie besitzen eine bestimmte Formatierung. Wenn möglich würde ich sie mit diesem Format übernehmen wollen.
aha, super Erklärung, und was heißt bei dir eine "bestimmte Formatierung". Range.Copy kopiert alles mit. Ich seh schon bei dir kommt man ohne Demo-Datei nicht weiter ... Biddeschön, daran kannst du's dir abschauen Demo-Datei
Wie du feststellen kannst geht einwandfrei !!
Dim ws As Worksheet, wsTarget As Worksheet
'Name des Zielsheets / bitte anpassen !!  
strNameTargetSheet = "TARGETSHEET"  
Set wsTarget = Worksheets(strNameTargetSheet)
'Zielsheet löschen  
wsTarget.UsedRange.Clear
'Für jedes Sheet in der Arbeitsmappe, außer dem Zielsheet  
For Each ws In Worksheets
    If Not ws.Name = strNameTargetSheet Then
        ' kopiere die belegten Daten von A4:Fx ins Zielsheet  
        ws.Range("A4:F" & ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy Destination:=wsTarget.Cells(wsTarget.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1)  
    End If
Next
Wenns jetzt bei dir nicht hinhaut. Bitte lade von dir eine Beispieldatei irgendwo hoch, damit man nachvollziehen kann wie es bei dir aussieht und was bei dir schief läuft! Danke.

Gruß jodel32
Member: Saphire
Saphire Mar 07, 2015 at 15:48:21 (UTC)
Goto Top
Danke sehr für deine grandiose und rasche Hilfe, funktioniert perfekt.

Lg
Ali