Zeilenwerte auslesen und ganze Zeilen kopieren
Kristopher
leider bin ich ein absoluter VBA-Neuling und relativ schnell mit einem für mich großen Programm betraut worden.
Es gibt zwei Dokumente, im ersten Dokument (A) soll jeweils der Wert der Spalte C geprüft werden. Wenn der Wert = 1 ist, dann soll er in der gleichen Zeile eine Spalte nach links wandern und den Wert der Zelle prüfen.
Mit diesem Wert / Inhalt der Zelle soll er ein neues, leeres Excel-Dokument öffnen und unter dem Namen des Wertes der Zelle abspeichern (Dokument C-1).
Ferner nimmt er den Wert der Zelle und prüft alle Zeilen der Spalte A im Dokument B auf diesen Wert. Hat die Zeile den entsprechenden Wert, so soll er die Zeile nehmen und in die erste leere Zeile des neuen Dokumentes (welches den Namen des Wertes der Zelle in Spalte B trägt, DokC-1) speichern.
Danach springt er wieder in Dokument A zurück und wandert eine Zeile abwärts. Nun wiederholt er die Prozedur indem er
den Wert der Zelle und prüft alle Zeilen der Spalte A im Dokument B auf diesen Wert. Hat die Zeile den entsprechenden Wert, so soll er die Zeile nehmen und in die erste leere Zeile des neuen Dokumentes C-1 speichern.
Ist er damit fertig, wiederholt er alle Schritte ab Es gibt zwei Dokumente, im ersten Dokument (A) .
Wie gesagt, als blutjunger Anfänger fühle ich mich diesem Problem noch nicht so richtig gewachsen, habe mich aber mal daran versucht. Die Lösung ist ziemlich kläglich.
Ich will niemand anderen dieses Programm schreiben lassen, allerdings habe ich doch arge Probleme mit einzelnen Teilen und für das Gesamtverständnis habe ich das Gesamtproblem geschildert. Bitte seht es nicht als Bitte / Aufforderung auf, mir meine gesamte Arbeit abzunehmen.
Besondere Probleme bereiten mir:
If Range("C:C").Value = 1 Then
Range("C:C").Offset(0, -1)
Range("C:C").Value = Comp
Er soll alle Zeilen der Spalte C auf den Wert 1 prüfen. Wenn ja, dann springt
er eine Spalte nach links und soll sich diesen Wert merken.
wo liegt das Problem?
If Range("A:A").Value = Comp Then
Comp.Select
Selection.Copy
Wenn der Wert einer Zeile in Spalte A dem Wert der variable Comp entspricht, dann soll er die gesamte Zeile markieren und dann kopieren... Glaube mein Befehl "Comp.Select" kann nicht funktioneren. gibts nen besseren Weg?
Vielen Dank schon jetzt für all eure Hilfen,
Grüße,
Oliver
PS: Bzgl. Der jeweils neuen Dokumente, die erstellt werden sollen, habe ich mich eines Tooles der Homepage von Herrn Stefan Kulpa, Dormagen, bedient. Vielen Dank hierfür!
Sub Test123()
If Range("C:C").Value = 1 Then
'Schritt 1
Range("C:C").Offset(0, -1)
Range("C:C").Value = Comp
'Schritt 2
Option Explicit
Public Function ExcelCreateWorkbook( _
sXLSFilePath As String) As Boolean
Dim objXLSheet As Object
On Error GoTo Err_ExcelCreateWorkbook
Set objXLSheet = CreateObject("Excel.Sheet")
objXLSheet.SaveAs sXLSFilePath
objXLSheet.Application.[Quit]
Set objXLSheet = Nothing
ExcelCreateWorkbook = True
Exit_ExcelCreateWorkbook:
Exit Function
Err_ExcelCreateWorkbook:
ExcelCreateWorkbook = False
Resume Exit_ExcelCreateWorkbook
End Function
End Function
'Schritt 3
Workbooks.Open ("...rlbk data oeffnen.xls")
'Schritt 4
If Range("A:A").Value = Comp Then
Comp.Select
Selection.Copy
Workbook("...11.xls").Activate
'Dokumentenname muss Comp entsprechen
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Select
Loop
ActiveSheet.Paste
End If
'Schritt 5
Workbooks.Activate ("...kernel.xls")
Range.Offset(1,0)
Range.Value = Comp
'Schritt 6
End If
'wiederhole Schritte 4 - 6
Workbooks.Open ("...rlbk data oeffnen.xls")
Do Until IsEmpty(ActiveCell.Value)
If Range("A:A").Value = Comp Then
Comp.Select
Selection.Copy
Workbook("...11.xls").Activate
'Dokumentenname muss Comp entsprechen
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Select
Loop
ActiveSheet.Paste
End If
Workbooks.Activate ("...kernel.xls")
Range.Offset(1,0)
Range.Value = Comp
Loop
'Schritt 7
'wiederhole Schritte 2 - 7
Do Until IsEmpty(ActiveCell.Value)
Range("C:C").Offset(0, -1)
Range("C:C").Value = Comp
'Schritt 2
Option Explicit
Public Function ExcelCreateWorkbook( _
sXLSFilePath As String) As Boolean
Dim objXLSheet As Object
On Error GoTo Err_ExcelCreateWorkbook
Set objXLSheet = CreateObject("Excel.Sheet")
objXLSheet.SaveAs sXLSFilePath
objXLSheet.Application.[Quit]
Set objXLSheet = Nothing
ExcelCreateWorkbook = True
Exit_ExcelCreateWorkbook:
Exit Function
Err_ExcelCreateWorkbook:
ExcelCreateWorkbook = False
Resume Exit_ExcelCreateWorkbook
End Function
End Function
'Schritt 3
Workbooks.Open ("...rlbk data oeffnen.xls")
'Schritt 4
If Range("A:A").Value = Comp Then
Comp.Select
Selection.Copy
Workbook("...11.xls").Activate
'Dokumentenname muss Comp entsprechen
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Select
Loop
ActiveSheet.Paste
End If
'Schritt 5
Workbooks.Activate ("...kernel.xls")
Range.Offset(1,0)
Range.Value = Comp
'Schritt 6
End If
'wiederhole Schritte 4 - 6
Workbooks.Open ("...rlbk data oeffnen.xls")
Do Until IsEmpty(ActiveCell.Value)
If Range("A:A").Value = Comp Then
Comp.Select
Selection.Copy
Workbook("...11.xls").Activate
'Dokumentenname muss Comp entsprechen
Do Until IsEmpty(ActiveCell.Value)
ActiveCell.Select
Loop
ActiveSheet.Paste
End If
Workbooks.Activate ("...kernel.xls")
Range.Offset(1,0)
Range.Value = Comp
Loop
'Schritt 7
Loop
End Sub