Bitte mal drüber schauen
10.08.2014 19:40:54
Laeubchen
es ist schon lang her, das ich mich mit Excel sowie VBA beschäftigt habe.
Nun habe ich ein wenig was zusammgebastelt.
Es wäre nett könnte Jemand so nett sein und mal rüber schauen, da ich mir nicht sicher bin, ob es Probleme geben kann und ob die Möglichkeit besteht, diesen Code etwas kürzer zu fassen.
Es handelt sich hierbei um Tabellenblätter (RT 1 und RT 2) die Daten enthalten, die später für den Ausdruck von Etiketten (Eti 1 und Eti 2) verwendet werden müssen.
So weit funktioniert die Datenübernahme.
Mein Problem ist ebenso, wenn eine Zeile mal freigelassen wird, so ist ein Etikett umsonst bzw mit den Grunddaten dazwischen. Das Problem besteht aber nur wenn keine Schweißnahtnummer mit der dazugehörigen Nennweite eingegeben wird. Das kann passieren, damit man den Überblick nicht verliert.
Ich hoffe ich konnte mich ein wenig verständlich ausdrücken und wäre für jeden guten Rat und Tipp dankbar.
Option Explicit
'Hiermit wird verlangt, dass alle benutzten Variablen definiert werden.
Sub ExportDaten()
' erstellt von Laeubchen
Application.ScreenUpdating = False
'Deaktiviert die Bildschirmaktualisierung während der Makro-Ausführung.
'Das Makro wird schneller ausgeführt und der Bildschirm flackert nicht.
' Schweißnahtnummer RT 1 Eti 1 FERTIG
Dim RngCopy As Range, RngPaste As Range
Dim aWerte()
Set RngCopy = Sheets("RT 1").Range("B28:F28")
Set RngPaste = Sheets("Eti 1").Range("B4:D4")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 1").Range("B29:F29")
Set RngPaste = Sheets("Eti 1").Range("I4:K4")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 1").Range("B30:F30")
Set RngPaste = Sheets("Eti 1").Range("B12:D12")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 1").Range("B31:F31")
Set RngPaste = Sheets("Eti 1").Range("I12:K12")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 1").Range("B32:F32")
Set RngPaste = Sheets("Eti 1").Range("B20:D20")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 1").Range("B33:F33")
Set RngPaste = Sheets("Eti 1").Range("I20:K20")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 1").Range("B34:F34")
Set RngPaste = Sheets("Eti 1").Range("B28:D28")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 1").Range("B35:F35")
Set RngPaste = Sheets("Eti 1").Range("I28:K28")
aWerte() = RngCopy
RngPaste = aWerte()
' Schweißnahtnummer RT 2 Eti 1 FERTIG
Set RngCopy = Sheets("RT 2").Range("B18:F18")
Set RngPaste = Sheets("Eti 1").Range("B36:F36")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B19:F19")
Set RngPaste = Sheets("Eti 1").Range("I36:K36")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B20:F20")
Set RngPaste = Sheets("Eti 1").Range("B44:B44")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B21:F21")
Set RngPaste = Sheets("Eti 1").Range("I44:K44")
aWerte() = RngCopy
RngPaste = aWerte()
' Schweißnahtnummer RT 2 Eti 2 FERTIG
Set RngCopy = Sheets("RT 2").Range("B22:F22")
Set RngPaste = Sheets("Eti 2").Range("B4:D4")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B23:F23")
Set RngPaste = Sheets("Eti 2").Range("I4:K4")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B24:F24")
Set RngPaste = Sheets("Eti 2").Range("B12:D12")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B25:F25")
Set RngPaste = Sheets("Eti 2").Range("I12:K12")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B26:F26")
Set RngPaste = Sheets("Eti 2").Range("B20:D20")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B27:F27")
Set RngPaste = Sheets("Eti 2").Range("I20:K20")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B28:F28")
Set RngPaste = Sheets("Eti 2").Range("B28:D28")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B29:F29")
Set RngPaste = Sheets("Eti 2").Range("I28:K28")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B30:F30")
Set RngPaste = Sheets("Eti 2").Range("B36:D36")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B31:F31")
Set RngPaste = Sheets("Eti 2").Range("B36:D36")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B32:F32")
Set RngPaste = Sheets("Eti 2").Range("I36:K36")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B34:F34")
Set RngPaste = Sheets("Eti 2").Range("B44:D44")
aWerte() = RngCopy
RngPaste = aWerte()
Set RngCopy = Sheets("RT 2").Range("B35:F35")
Set RngPaste = Sheets("Eti 2").Range("I44:K44")
aWerte() = RngCopy
RngPaste = aWerte()
' Nennweiten Eti 1 FERTIG
Dim Rng1Copy As Range, Rng1Paste As Range
Dim bWerte()
Set Rng1Copy = Sheets("RT 1").Range("M28:N28")
Set Rng1Paste = Sheets("Eti 1").Range("F5")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 1").Range("M29:N29")
Set Rng1Paste = Sheets("Eti 1").Range("M5")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 1").Range("M30:N30")
Set Rng1Paste = Sheets("Eti 1").Range("F13")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 1").Range("M31:N31")
Set Rng1Paste = Sheets("Eti 1").Range("M13")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 1").Range("M32:N32")
Set Rng1Paste = Sheets("Eti 1").Range("F21")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 1").Range("M33:N33")
Set Rng1Paste = Sheets("Eti 1").Range("M21")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 1").Range("M34:N34")
Set Rng1Paste = Sheets("Eti 1").Range("F29")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 1").Range("M35:N35")
Set Rng1Paste = Sheets("Eti 1").Range("M29")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
' Nennweiten Eti 1 RT 2
Set Rng1Copy = Sheets("RT 2").Range("M18:N18")
Set Rng1Paste = Sheets("Eti 1").Range("F37")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M19:N19")
Set Rng1Paste = Sheets("Eti 1").Range("M37")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M20:N20")
Set Rng1Paste = Sheets("Eti 1").Range("F45")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M21:N21")
Set Rng1Paste = Sheets("Eti 1").Range("M45")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
' Nennweiten Eti 2 RT 2
Set Rng1Copy = Sheets("RT 2").Range("M22:N22")
Set Rng1Paste = Sheets("Eti 2").Range("F5")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M23:N23")
Set Rng1Paste = Sheets("Eti 2").Range("M5")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M24:N24")
Set Rng1Paste = Sheets("Eti 2").Range("F13")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M25:N25")
Set Rng1Paste = Sheets("Eti 2").Range("M13")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M26:N26")
Set Rng1Paste = Sheets("Eti 2").Range("F21")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M27:N27")
Set Rng1Paste = Sheets("Eti 2").Range("M21")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M28:N28")
Set Rng1Paste = Sheets("Eti 2").Range("F29")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M29:N29")
Set Rng1Paste = Sheets("Eti 2").Range("M29")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M30:N30")
Set Rng1Paste = Sheets("Eti 2").Range("F37")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M31:N31")
Set Rng1Paste = Sheets("Eti 2").Range("M37")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M32:N32")
Set Rng1Paste = Sheets("Eti 2").Range("F45")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M33:N33")
Set Rng1Paste = Sheets("Eti 2").Range("M45")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M34:N34")
Set Rng1Paste = Sheets("Eti 2").Range("F44")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
Set Rng1Copy = Sheets("RT 2").Range("M35:N35")
Set Rng1Paste = Sheets("Eti 2").Range("M44")
bWerte() = Rng1Copy
Rng1Paste = bWerte()
'Nennweiten Format
Sheets("Eti 1").Range("F5, M5, F13, M13, F21, M21, F29, M29, F37, M37, F45, M45"). _
NumberFormat = """t = ""@ ""mm"""
Sheets("Eti 2").Range("F5, M5, F13, M13, F21, M21, F29, M29, F37, M37, F45, M45"). _
NumberFormat = """t = ""@ ""mm"""
'Grunddaten
'Projekt Eti 1
Set RngCopy = Sheets("RT 1").Range("AE6:AX6")
Set RngPaste = Sheets("Eti 1").Range("B2:D2, I2:K2, B10:D10, I10:K10, B18:D18, I18:K18, _
_
_
_
_
_
_
_
B26:D26, I26:K26, B34:D34, I34:I34, B42:D42, I42:I42")
aWerte() = RngCopy
RngPaste = aWerte()
'Projekt Eti 2
Set RngCopy = Sheets("RT 1").Range("AE6:AX6")
Set RngPaste = Sheets("Eti 2").Range("B2:D2, I2:K2, B10:D10, I10:K10, B18:D18, I18:K18, _
_
_
_
_
_
_
_
B26:D26, I26:K26, B34:D34, I34:I34, B42:D42, I42:I42")
aWerte() = RngCopy
RngPaste = aWerte()
'Prüfobjekt Eti 1
Set RngCopy = Sheets("RT 1").Range("AY6:BL6")
Set RngPaste = Sheets("Eti 1").Range("B3:D3, I3:K3, B11:D11, I11:K11, B19:D19, I19:K19, _
_
_
_
_
_
_
_
B27:D27, I27:K27, B35:D35, I35:I35, B43:D43, I43:I43")
aWerte() = RngCopy
RngPaste = aWerte()
'Prüfobjekt Eti 2
Set RngCopy = Sheets("RT 1").Range("AY6:BL6")
Set RngPaste = Sheets("Eti 2").Range("B3:D3, I3:K3, B11:D11, I11:K11, B19:D19, I19:K19, _
_
_
_
_
_
_
_
B27:D27, I27:K27, B35:D35, I35:I35, B43:D43, I43:I43")
aWerte() = RngCopy
RngPaste = aWerte()
'Schmitt-Nr. Eti 1
Set RngCopy = Sheets("RT 1").Range("BH4:BI4")
Set RngPaste = Sheets("Eti 1").Range("F1, M1, F9, M9, F17, M17, F25, M25, F33, M33, F41, _
M41")
aWerte() = RngCopy
RngPaste = aWerte()
'Schmitt-Nr. Eti 2
Set RngCopy = Sheets("RT 1").Range("BH4:BI4")
Set RngPaste = Sheets("Eti 2").Range("F1, M1, F9, M9, F17, M17, F25, M25, F33, M33, F41, _
M41")
aWerte() = RngCopy
RngPaste = aWerte()
'Auftrags-Nr. Eti 1
Set RngCopy = Sheets("RT 1").Range("M6:AD6")
Set RngPaste = Sheets("Eti 1").Range("F2, M2, F10, M10, F18, M18, F26, M26, F34, M34, F42, _
_
_
_
_
_
_
_
M42")
aWerte() = RngCopy
RngPaste = aWerte()
'Auftrags-Nr. Eti 2
Set RngCopy = Sheets("RT 1").Range("M6:AD6")
Set RngPaste = Sheets("Eti 2").Range("F2, M2, F10, M10, F18, M18, F26, M26, F34, M34, F42, _
_
_
_
_
_
_
_
M42")
aWerte() = RngCopy
RngPaste = aWerte()
'Berichts-Nr. Eti 1
Set RngCopy = Sheets("RT 1").Range("BK4:BL4")
Set RngPaste = Sheets("Eti 1").Range("F4, M4, F12, M12, F20, M20, F28, M28, F36, M36, F44, _
_
_
_
_
_
_
_
M44")
aWerte() = RngCopy
RngPaste = aWerte()
'Berichts-Nr. Eti 2
Set RngCopy = Sheets("RT 1").Range("BK4:BL4")
Set RngPaste = Sheets("Eti 2").Range("F4, M4, F12, M12, F20, M20, F28, M28, F36, M36, F44, _
_
_
_
_
_
_
_
M44")
aWerte() = RngCopy
RngPaste = aWerte()
'Datum Eti 1 mit Formatierung des Datums
Set RngCopy = Sheets("RT 1").Range("AP10:AX10")
Set RngPaste = Sheets("Eti 1").Range("D5, K5, D13, K13, D21, K21, D29, K29, D37, K37, D45, _
_
_
_
_
_
_
_
K45")
Range("D5, K5, D13, K13, D21, K21, D29, K29, D37, K37, D45, K45").NumberFormat = "dd/mm/ _
yyyy;@"
aWerte() = RngCopy
RngPaste = aWerte()
'Datum Eti 2 mit Formatierung des Datums
Set RngCopy = Sheets("RT 1").Range("AP10:AX10")
Set RngPaste = Sheets("Eti 2").Range("D5, K5, D13, K13, D21, K21, D29, K29, D37, K37, D45, _
_
_
_
_
_
_
_
K45")
Range("D5, K5, D13, K13, D21, K21, D29, K29, D37, K37, D45, K45").NumberFormat = "dd/mm/ _
yyyy;@"
aWerte() = RngCopy
RngPaste = aWerte()
Application.CutCopyMode = False: Application.ScreenUpdating = True
'Die Kopiermarkierung aufheben und die Bildschirmaktualisierung wieder aktivieren
End Sub