Hallo zusammen!

ich habe ein Problem! und zwar geht es darum, dass ich aus einem Workbook (Source) in einem bestimmten Worksheet mit sehr vielen Daten an den Daten interessiert bin, die in der Spalte A sagen wir mit der Buchstabe "CA" belegt sind.
In dieser Spalte des Worksheets sind die CAs willkuerlich verteilt. Das heisst z,b. Zeile 1 bestit in der Spalte A (A1) ein CA dann wieder Zeile 5 (A5) und dann wieder 13 (A13) usw.
Ich hole mir diese Zeile und fuege sie in einem anderen neuen Workbook (Destination) mit einem anderen Pfad in einem der Wokrsheets an der erste freie nicht belegte Zeile.
Das ist der Plan! aber er geht noch nicht auf.

Ich habe dazu einen Teil meines Programmes herauskopiert und hoffe ihr koennt mir helfen.

Ich komme leider aus dieser Do-Loppschleife nicht mehr raus. Es wiederholt sich immer und immer wieder! Ich weiss zusaetzlich nicht ob das der richte weg ist.

Danke fuer eure Hilfe!


Der Code:



'opening the source
Workbooks.Open (Sourcepath & "\" & file)
Workbooks(file).Activate

'sourcesheet
Set source_ws = Sheets("MY" & MY & " Sales as of " & CY & "_Q" & Q)
source_ws.Activate

s = 1

'da ich nicht will, dass das progamm tausende zellen immer durchsucht
'finding last row in sourcesheet

Last = Range("A:A").Find(What:="*", After:=Range("A" & s), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, SearchFormat:=False).row



Do

Workbooks(file).Activate
Set source_ws = Sheets("MY" & MY & " Sales as of " & CY & "_Q" & Q)
source_ws.Activate
'Finds range of sales data for State
row = Range("A:A").Find(What:="CA", After:=Range("A" & s), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).row

'next blank row in destination sheet
Workbooks("Modelcodes and Wholesale for CA.xlsm").Activate
Set dest_ws = Sheets("overview")
dest_ws.Activate

Lastrow = ActiveSheet.UsedRange.Rows.Count

dest_ws.Cells(Lastrow, 1) = source_ws.Cells(row, 2)

'last CA in the sheet
Workbooks(file).Activate
Set source_ws = Sheets("MY" & MY & " Sales as of " & CY & "_Q" & Q)
source_ws.Activate

LastCA = Range("A:A").Find(What:="CA", After:=Range("A" & s), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, SearchFormat:=False).row

'exiting loop
If row = LastCA Then Exit Do

's = row

Loop 'Until s <= Last

Alternativ habe ich mir auch diesen Code euberlegt. Er funktioniert leider auch nicht. Dabei weiss ich leider nicht einmal ob ich auf dem richtigen Weg bin.

'dadurch, dass es zwei unterschiedliche Workbook mit unterschiedlichen Pfads
'(sourcesheet und destinationsheet) sind muesste ich doch erst das workbook und
'dann das sheet offnen aus denen ich etwas herauslesen will?
'oeffnen bevor ich den code starte. also erstmal schreiben:

file = "Bikes.xlsm"
'opening the source
Workbooks.Open (Sourcepath & "\" & file)
Workbooks(file).Activate

'das ist mein sourcesheet

Set source_ws = Sheets("MY" & MY & " Sales as of " & CY & "_Q" & Q)
source_ws.Activate

'dann kommt:

Dim bleibt As Range

With ActiveSheet.Columns(1)
On Error Resume Next
Set bleibt = .ColumnDifferences(.Find("CA", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True))
On Error GoTo 0
If Not bleibt Is Nothing Then bleibt.EntireRow.Hidden = True
.SpecialCells(xlCellTypeVisible).EntireRow.Copy

'bisher wird die zeile gesuch und kopiert kopiert?
'um sie dann in dem anderen workbook mit einem neuen pfad einzufuegen und zwar an erste freie stelle muesste ich doch jetzt erst dieses oeffnen und dann auch
'noch den sheet oder?
'also folgendes machen:

'opening destination workbook

Workbooks("Codes for CA.xlsm").Activate

'destination sheet bestimmen
Set dest_ws = Sheets("CA")
dest_ws.Activate

'und anschliessend:
'diese Zeile ist mir leider absolut unklar. ich verstehe nicht  was hier genau gemacht wir

Sheets(.Parent.Next.Index).Cells(Sheets(.Parent.Next.Index).Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
Application.CutCopyMode = False
.EntireRow.Hidden = False
End With
 

ErrMsg:
MsgBox ("Cannot find Workbook, check path and filename, and try again")
Exit Sub

End Sub

Danke fuer eure Hilfe

B.