Hallo erstmal,
zum einen einen ganz großen Dank an die Mitwirkenden auf dieser Plattform. Hab mir schon viele Infos holen können, die meine eher Laienhafte VBA Programmierung stark voran getrieben haben.
Jetzt zum Problem (das eigentlich keins ist!)
Mit dem angehängten Code wird im Endeffekt entsprechend der Auswahl aus der Userform aus verschiedenen Tabellenblättern der vorhandene Inhalt kopiert und in eine neue Arbeitsmappe geschrieben.
Der Code funktioniert auch so wie er ist (fast) perfekt.
Da ich aber gerne noch was lernen möchte nun die Frage:
Kann ich die Komplette Abfrage der Checkboxen nicht in eine Schleife packen, um auch eine eventuell spätere Nachbearbeitung zu vereinfachen?
Ich habs versucht und bin vollkommen gescheitert...
Das einzige was auch in diesem Code nicht immer (mal schon, mal nicht) funktioniert, ist das die Zeilenhöhe der Überschrift nicht im Format übernommen wird und dann zusammengeschoben ist.
Ich wäre dankbar, wenn ihr mir beim Code helfen würdet und gerne auch mit einer kurzen Erklärung...
Möchte es gerne verstehen...!!
Vielen Dank im Voraus!
zum einen einen ganz großen Dank an die Mitwirkenden auf dieser Plattform. Hab mir schon viele Infos holen können, die meine eher Laienhafte VBA Programmierung stark voran getrieben haben.
Jetzt zum Problem (das eigentlich keins ist!)
Mit dem angehängten Code wird im Endeffekt entsprechend der Auswahl aus der Userform aus verschiedenen Tabellenblättern der vorhandene Inhalt kopiert und in eine neue Arbeitsmappe geschrieben.
Der Code funktioniert auch so wie er ist (fast) perfekt.
Da ich aber gerne noch was lernen möchte nun die Frage:
Kann ich die Komplette Abfrage der Checkboxen nicht in eine Schleife packen, um auch eine eventuell spätere Nachbearbeitung zu vereinfachen?
Ich habs versucht und bin vollkommen gescheitert...
Das einzige was auch in diesem Code nicht immer (mal schon, mal nicht) funktioniert, ist das die Zeilenhöhe der Überschrift nicht im Format übernommen wird und dann zusammengeschoben ist.
Ich wäre dankbar, wenn ihr mir beim Code helfen würdet und gerne auch mit einer kurzen Erklärung...
Möchte es gerne verstehen...!!
Vielen Dank im Voraus!
VB.NET-Quellcode
- Private Sub Erstellen_Click()
- Dim gbis As Date
- 'Kopfzeile befüllen
- If Me.Betr = "" Then
- MsgBox ("Bitte Kürzel eingeben")
- Exit Sub
- Else
- Worksheets("Preisliste").Range("F1") = Me.Betr
- End If
- If Me.KDNummer = "" Then
- MsgBox ("Bitte eine Kundennummer eingeben")
- Exit Sub
- Else
- Worksheets("Preisliste").Range("B3") = Me.KDNummer
- End If
- If Me.KDName = "" Then
- MsgBox ("Bitte einen Kundennamen eingeben")
- Exit Sub
- Else
- Worksheets("Preisliste").Range("B4") = Me.KDName
- End If
- If Me.Guelt_Ab = "" Then
- MsgBox ("Bitte Gültiges Datum oder Format eingeben!")
- Exit Sub
- Else
- If Me.Guelt_Ab.Value = Format(CDate(Guelt_Ab.Value), "dd.mm.yyyy") Then
- gbis = Format(CDate(Me.Guelt_Ab.Value), "yyyy")
- Worksheets("Preisliste").Range("F3") = Me.Guelt_Ab
- Worksheets("Preisliste").Range("F4") = DateSerial(gbis, 12, 31)
- Else
- MsgBox ("Bitte Gültiges Datum oder Format eingeben!")
- End If
- End If
- 'Checkboxen abfragen und in die leere Vorlage kopieren
- If Me.CB_RTC_Tag.Value = True Then
- Worksheets("RTC_Tag").Range("A1:F" & Sheets("RTC_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTC_Bed.Value = True Then
- Worksheets("RTC_Bed").Range("A1:F" & Sheets("RTC_Bed").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTL_75_Tag.Value = True Then
- Worksheets("RTL_Tag").Range("A1:F" & Sheets("RTL_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTL_75_Bed.Value = True Then
- Worksheets("RTL_Bed").Range("A1:F" & Sheets("RTL_Bed").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTL_U75_Tag.Value = True Then
- Worksheets("RTL_U75_Tag").Range("A1:F" & Sheets("RTL_U75_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTL_U75_Bed.Value = True Then
- Worksheets("RTL_U75_Bed").Range("A1:F" & Sheets("RTL_U75_Bed").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTL_Kom_Tag.Value = True Then
- Worksheets("Kommunal_Tag").Range("A1:F" & Sheets("Kommunal_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RS_Tag.Value = True Then
- Worksheets("RS_Tag").Range("A1:F" & Sheets("RS_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RGT_Tag.Value = True Then
- Worksheets("RGT_Tag").Range("A1:F" & Sheets("RGT_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RST_Tag.Value = True Then
- Worksheets("RST_Tag").Range("A1:F" & Sheets("RST_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTR_Light_Tag.Value = True Then
- Worksheets("RTR_Light_Tag").Range("A1:F" & Sheets("RTR_Light_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTR_Light_Bed.Value = True Then
- Worksheets("RTR_Light_Bed").Range("A1:F" & Sheets("RTR_Light_Bed").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTR_RT_Tag.Value = True Then
- Worksheets("RTR_RT_Tag").Range("A1:F" & Sheets("RTR_RT_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTR_RT_Bed.Value = True Then
- Worksheets("RTR_RT_Bed").Range("A1:F" & Sheets("RTR_RT_Bed").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTA_Tag.Value = True Then
- Worksheets("RTA_Tag").Range("A1:F" & Sheets("RTA_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RMB_Tag.Value = True Then
- Worksheets("RMB_Tag").Range("A1:F" & Sheets("RMB_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RMS_Tag.Value = True Then
- Worksheets("RMS_Tag").Range("A1:F" & Sheets("RMS_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTS_Starr_Tag.Value = True Then
- Worksheets("RTS_Starr_Tag").Range("A1:F" & Sheets("RTS_Starr_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_RTS_Roto_Tag.Value = True Then
- Worksheets("RTS_Roto_Tag").Range("A1:F" & Sheets("RTS_Roto_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_Transport_Tag.Value = True Then
- Worksheets("Transport_Tag").Range("A1:F" & Sheets("Transport_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_Transport_Bed.Value = True Then
- Worksheets("Transport_Bed").Range("A1:F" & Sheets("Transport_Bed").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- If Me.CB_Kran_Tag.Value = True Then
- Worksheets("Kran_Tag").Range("A1:F" & Sheets("Kran_Tag").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- End If
- 'Fußzeilen einfügen
- Worksheets("TK_Tieflader").Range("A1:F" & Sheets("TK_Tieflader").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- Worksheets("TK_LKW_Anh").Range("A1:F" & Sheets("TK_LKW_Anh").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- Worksheets("TK_Stapler").Range("A1:F" & Sheets("TK_Stapler").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- Worksheets("FZ_Allg").Range("A1:F" & Sheets("FZ_Allg").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- Worksheets("FZ_Selbstf").Range("A1:F" & Sheets("FZ_Selbstf").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- Worksheets("FZ_Bed").Range("A1:F" & Sheets("FZ_Bed").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Copy _
- Destination:=Worksheets("Preisliste").Range("A" & Sheets("Preisliste").Cells(Rows.Count, 1).End(xlUp).Row + 2)
- 'Tabelle 1 in neue Mappe kopieren und speichern
- Call TabCopy
- End Sub
- Sub TabCopy()
- Dim vntBlattName As Variant
- Dim strWkbName As String
- Dim strPfad As String
- strPfad = "H:\"
- strWkbName = Format(CDate(Me.Guelt_Ab), "yyyy") & "-SP-" & Me.KDName & "-" & Me.KDNummer & "-" & Me.Betr
- vntBlattName = ("Preisliste")
- Sheets(vntBlattName).Copy
- ActiveWorkbook.SaveAs strPfad & strWkbName
- 'ActiveWorkbook.Close
- Workbooks("SP_Liste_Generator.xlsm").Activate
- Application.Visible = True
- Worksheets("Preisliste").Range("A6:F1000").Delete
- ActiveWorkbook.Save
- Workbooks("SP_Liste_Generator.xlsm").Close
- End Sub
Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Rehripper“ ()