Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
488to492
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
488to492
488to492
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Code Ändern

Code Ändern
21.09.2004 07:56:20
Matthias
Hallo Forum
Ich hab nen Prob. mit folgendem Qeullcode.
Ich generiere vor weg 41 Tabellenblätter die meistens auch mit werten belegt sind. Aber wenn ich nun Tabelllenblätter habe die nicht belegt sind übernimmt dieses Programm die vor defienierten Einstellungen (Überschrifften, Datum usw.)die im Bereich (A2:J33) liegen Dieser code müste jetzt so geändert werden, dass er den Bereich von (A6:J31)abfragt ob der Bereich mit werten belegt ist wenn ja soll er dass Tabellenblatt umwandeln wenn nicht soll er es löschen

(!Wichtig ist dabei aber das er auch das Tabellenblatt als belegt erkennt wenn z.B. nur der Bereich Von (A6:J6) belegt ist.!)

Sub TabellenZuText()
Dim wb As Workbook
Dim wbA As Workbook
Dim intZ As Integer
Dim lngWS As Long
Set wbA = ActiveWorkbook
lngWS = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Workbooks.Add
Application.SheetsInNewWorkbook = lngWS
Application.DisplayAlerts = False
With wb.Sheets(1)
For intZ = 1 To intZ + 41
wbA.Sheets("Page_" & intZ).Range("A1:J33").Copy .Cells(intZ * 33, 1)
Next intZ
.Rows("1:32").Delete
.Parent.SaveAs Filename:="C:\Exel-CSV\CSV\Partlist txt\Partlist Plates.txt", FileFormat:=xlText, _
CreateBackup:=False
.Parent.Close False
End With
Application.DisplayAlerts = True
End Sub

Ich bitte um eure hilfe und bedanke mich schonmal im Vorraus
Mfg Matthias

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code Ändern
21.09.2004 08:09:11
Torsten
Moin Matthias,
ich würde zwei schleifen aussenrum legen:
beginnend mit:
bereich festlegen, in dem gearbeitet werden soll (anzahl blätter)
for i = 1 to worksheets.count
schauen ob ein wert in der zelle steht:
if worksheets(i).cells(1,2) "" then
wenn ja dann mache dieses (deine programmierung)

else
next i
viele grüsse
torsten
AW: Code Ändern
21.09.2004 08:19:25
Matthias
Ich habe dass jetzt so gemacht aber erhalte Next ohne For wo ist da denn der fehler?

Sub TabellenZuText()
Dim wbDummy As Workbook
Dim wbA As Workbook
Dim intZ As Integer
Dim lngWS As Long
For i = 1 To Worksheets.Count
If Worksheets(i).Cells(1, 2) <> "" Then
Set wbA = ActiveWorkbook
lngWS = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wbDummy = Workbooks.Add
Application.SheetsInNewWorkbook = lngWS
Application.DisplayAlerts = False
With wbDummy.Sheets(1)
For intZ = 1 To intZ + 41
wbA.Sheets("Page_" & intZ).Range("A1:J33").Copy .Cells(intZ * 33, 1)
Next intZ
.Rows("1:32").Delete
.Parent.SaveAs Filename:="C:\Exel-CSV\CSV\Partlist txt\Partlist Plates.txt", FileFormat:=xlText, _
CreateBackup:=False
.Parent.Close False
End With
Application.DisplayAlerts = True
Else
Next i
End 

Sub

Anzeige
AW: Code Ändern
21.09.2004 08:30:45
Torsten
hallo,
nach else muß end if stehen, hatte ich eben vergessen, sorry
AW: Code Ändern
21.09.2004 08:40:31
Matthias
Ersteinmal möchte ich mich für deine hilfe bedanken
Leider funktioniert es nicht so wie ich es mir vor gestellt habe. Es werden immer noch die Werte Vom Bereich (A2:j5) und von (A32:J33) in die Txt Datei über nommen und das sollte eigentlich verhindert werden wenn in dem bereich von (A6:j31) kein werte stehen sollte.
Mfg Matthias
AW: Code Ändern
21.09.2004 09:18:08
Torsten
vielleicht stellst du deine datei mal zur verfügung, dann kann ich mir ein besseres bild darüber machen.
AW: Code Ändern
21.09.2004 09:27:23
Matthias
Dass ist die txt datei die rauskommt biss Page_38 Stimmt es dann auch aber alles was danach steht sollte nach möglichkeit vor der konvertierung gelöscht werden.
Hoffentlich ist das jetzt besser verständlich.
Mfg Matthias
Anzeige
Frage
21.09.2004 09:42:58
Torsten
kann die bedingung an der zelle in spalte a festgemacht werden, wenn der eintrag ein wert und grösser als 1 ist?
AW: wenn, dann geht bei mir so
21.09.2004 09:49:33
Torsten

Sub TabellenZuText()
Dim wb As Workbook
Dim wbA As Workbook
Dim intZ As Integer
Dim lngWS As Long
Set wbA = ActiveWorkbook
lngWS = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Workbooks.Add
Application.SheetsInNewWorkbook = lngWS
Application.DisplayAlerts = False
With wb.Sheets(1)
For zeile = 1 To 36
If wbA.Sheets(intZ).Cells(zeile, 1) < 0 Then
For intZ = 1 To intZ + 41
wbA.Sheets("Page_" & intZ).Range("A1:J33").Copy .Cells(intZ * 33, 1)
Next intZ
.Rows("1:32").Delete
.Parent.SaveAs Filename:="C:\Exel-CSV\CSV\Partlist txt\Partlist Plates.txt", FileFormat:=xlText, _
CreateBackup:=False
.Parent.Close False
End If
Next zeile
End With
Application.DisplayAlerts = True
End Sub

' wenn die spalte auch noch abgefragt werden müssen, könnte dies in einer weiteren for netxt schleife getan werden.
Anzeige
AW: wenn, dann geht bei mir so
21.09.2004 10:05:03
Matthias
Bei mir erscheint leider nur ein Laufzeitfehle 9 und zwar in der zeile ab If wbA.Sheets(intZ)usw
AW: wenn, dann geht bei mir so
21.09.2004 10:13:22
Torsten
dieser ausdruck "wbA.Sheets(intZ)"´bezieht sich auf das arbeitsblatt, in dem die zu suchenden werte stehen. richtigerweise müssete dies heissen "thisworkbook.worksheets("hier muß der Name deines arbeitsblattes stehen")". wenn das mehr als eines ist muss das angebpasst werden, in der vorlage habe ich nur eines gesehen.
AW: wenn, dann geht bei mir so
21.09.2004 10:34:16
Matthias
Jetzt funzt es garnicht mehr aber trotzdem nochmal danke für deine hilfe
Ich werde es beim alten Quelcode belassen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige