Leere Zeilen und Textzeilen überspringen
31.07.2006 10:01:01
Susi79
ich würde wieder einmal eure Hilfe bei folgendem Problem benötigen.
Also ich habe eine Spalte mit Artikelnummern, dazwischen stehen jedoch ab und zu Zeilen ohne Text und Bereichsüberschriften - in Tabelle 1.
In Tabelle 2 habe ich eine Gesamtübersicht mit den aktuellen Artikelbeständen, welche in Tabelle 1 eingefügt werden sollen. Da Tabelle 1 diese Werte in einer anderen Sortierung enthält und sich Tabelle 2 durch neue Artikel ändert, kann ich nicht mit festen Zellenwerten arbeiten.
Aus diesem Grund lass ich die Artikelnummer aus Tabelle 1 kopieren, in Tabelle 2 suchen, den entsprechenden Bestand kopieren und in Tabelle 1 einfügen.
Komme ich in Tabelle 1 allerdings in eine Leerzeile, läuft das Makro nicht mehr weiter. Ich habe bisher noch nicht herausgefunden weshalb :-( und hoffe hier auf eure Hilfe.
Hier das aktuelle Makro:
Sub AutomatischeDatenÜbernahme()
' Schleifenroutine
' Übernahme der Artikel-Nummer aus der Endtabelle für die Suche in der
' Datentabelle
' Tabelle 1 aktivieren
Sheets("ArtikelDetail").Select
Dim Zaehler, max
max = 70
Zaehler = 11
'wegen Buchstaben:
On Error Resume Next
Do While Zaehler <= max
Cells(Zaehler, 1).Activate
If Cells(Zaehler, 1) > 1 Then
Range("Zaehler, 1").Select
Selection.Copy
Dim Suchstring As String
Suchstring = ActiveCell
' Suche in der Datentabelle nach der Artikel-Nummer - Spalte B
' Suchinhalt als Variable aus dem obigen kopierten Wert bestimmen
' Tabelle aktivieren
Sheets("DatenVerpDetail").Select
Cells.Find(What:=Suchstring, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
' 4 Spalten nach rechts von der aktiven Zelle aus
ActiveCell.Offset(0, 4).Activate
Selection.Copy
' Übernahme des Wertes in die Endtabelle in Spalte Monat
Sheets("VerpDetail").Select
Range("Zaehler, 1").Select
ActiveCell.Offset(0, 8).Activate
' Einfügen des Wertes
ActiveSheet.Paste
Application.CutCopyMode = False
' Fortsetzung mit nächster Zeile
Zaehler = Zaehler + 1
End If
Loop
MsgBox "Alle Werte wurden übernommen"
End Sub
Findet ihr eventuell den Grund warum bei einer Leerzeile das Makro in einer Art Wiederholungsschleife in dieser Leerzeile hängen bleibt?
Vielen Dank für eure Hilfe.