Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
340to344
340to344
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ich kann die kopierten Werte nicht einfügen

Forumthread: Ich kann die kopierten Werte nicht einfügen

Ich kann die kopierten Werte nicht einfügen
20.11.2003 12:29:21
marc
hallo zusammen
ich will eine Aufgabe automatisieren,
habe ein Vba-Code geschrieben und jetzt stehe ich vor dem Ende (im Programm) und kann nicht weiter.
Ich kann die kopierten werte nicht einfügen

ich will die kopierten Werte in die letzte/leere Spalte einfügen
der Spaltenanfang ist ("D") die werte werden 1x wöchentlich in
nächste leere Spalte eingetragen.


Sub ErrorExpToChart_Step2()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim c As Range
Worksheets("Aus.Gr").Activate
If [G5] = "350" Then
Sheets(4).Range("C9") = Sheets(2).Range("C9").Value
Sheets(4).Range("D9") = Sheets(2).Range("G9").Value
Sheets(4).Range("E9") = Sheets(2).Range("H9").Value
Sheets(4).Range("F9") = Sheets(2).Range("I9").Value
Sheets(4).Range("G9") = Sheets(2).Range("J9").Value
Sheets(4).Range("H9") = Sheets(2).Range("H5").Value
End If
If [G5] = "212" Then
Sheets(4).Range("C11") = Sheets(2).Range("C9").Value
Sheets(4).Range("D11") = Sheets(2).Range("G9").Value
Sheets(4).Range("E11") = Sheets(2).Range("H9").Value
Sheets(4).Range("F11") = Sheets(2).Range("I9").Value
Sheets(4).Range("G11") = Sheets(2).Range("J9").Value
Sheets(4).Range("H11") = Sheets(2).Range("H5").Value
End If
If [G5] = "180" Then
Sheets(4).Range("C14") = Sheets(2).Range("C9").Value
Sheets(4).Range("D14") = Sheets(2).Range("G9").Value
Sheets(4).Range("E14") = Sheets(2).Range("H9").Value
Sheets(4).Range("F14") = Sheets(2).Range("I9").Value
Sheets(4).Range("G14") = Sheets(2).Range("J9").Value
Sheets(4).Range("H14") = Sheets(2).Range("H5").Value
End If
If [G5] = "230" Then
Sheets(4).Range("C7") = Sheets(2).Range("C9").Value
Sheets(4).Range("D7") = Sheets(2).Range("G9").Value
Sheets(4).Range("E7") = Sheets(2).Range("H9").Value
Sheets(4).Range("F7") = Sheets(2).Range("I9").Value
Sheets(4).Range("G7") = Sheets(2).Range("J9").Value
Sheets(4).Range("H7") = Sheets(2).Range("H5").Value
End If
If [G5] = "192" Then
Sheets(4).Range("C8") = Sheets(2).Range("C9").Value
Sheets(4).Range("D8") = Sheets(2).Range("G9").Value
Sheets(4).Range("E8") = Sheets(2).Range("H9").Value
Sheets(4).Range("F8") = Sheets(2).Range("I9").Value
Sheets(4).Range("G8") = Sheets(2).Range("J9").Value
Sheets(4).Range("H8") = Sheets(2).Range("H5").Value
End If
If [G5] = "149" Then
Sheets(4).Range("C10") = Sheets(2).Range("C9").Value
Sheets(4).Range("D10") = Sheets(2).Range("G9").Value
Sheets(4).Range("E10") = Sheets(2).Range("H9").Value
Sheets(4).Range("F10") = Sheets(2).Range("I9").Value
Sheets(4).Range("G10") = Sheets(2).Range("J9").Value
Sheets(4).Range("H10") = Sheets(2).Range("H5").Value
End If
If [G5] = "196" Then
Sheets(4).Range("C12") = Sheets(2).Range("C9").Value
Sheets(4).Range("D12") = Sheets(2).Range("G9").Value
Sheets(4).Range("E12") = Sheets(2).Range("H9").Value
Sheets(4).Range("F12") = Sheets(2).Range("I9").Value
Sheets(4).Range("G12") = Sheets(2).Range("J9").Value
Sheets(4).Range("H12") = Sheets(2).Range("H5").Value
End If
If [G5] = "190" Then
Sheets(4).Range("C13") = Sheets(2).Range("C9").Value
Sheets(4).Range("D13") = Sheets(2).Range("G9").Value
Sheets(4).Range("E13") = Sheets(2).Range("H9").Value
Sheets(4).Range("F13") = Sheets(2).Range("I9").Value
Sheets(4).Range("G13") = Sheets(2).Range("J9").Value
Sheets(4).Range("H13") = Sheets(2).Range("H5").Value
End If
Worksheets("QAL_Ges").Activate
Range("C7:H14").Copy
Workbooks.Open ("C:\Geradeauslauf\Q_Alarm\QAlarm_Ges.xls")
Worksheets("Q_AlarmTL_Info").Activate
Range("R7").PasteSpecial Paste:=xlValues, Paste:=xlFormats
Range("A4").Activate
Sheets("QA_DB").Activate
Range("D65536").End(xlUp).Offset(1, 0).Activate
Application.ScreenUpdating = False
Worksheets("Q_AlarmTL_Info").Activate
Range("W7:W14").Copy
'Fehler ich will die kopierten Werte in die letzte/leere Spalte einfügen
'der Spaltenanfang ist ("D") die werte werden 1x wöchentlich in
'nächste leere Spalte eingetragen
Worksheets("QA_DB").Activate
'ActiveCell.Offset(0, 0).PasteSpecial Paste:=Values
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Worksheets("Aus.Gr").Activate
End Sub

Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ich kann die kopierten Werte nicht einfügen
20.11.2003 12:59:54
Nike 

Sub ErrorExpToChart_Step2()
Dim wb As Workbook
Dim wkbAus As Workbook
Set wb = ActiveWorkbook
Dim c As Range
Dim intQZeil As Integer
Dim intZZeil As Integer
Dim lngLzeil As Long
Select Case wb.Worksheets("Aus.Gr").Range("G5")
Case "350"
wb.Sheets(4).Range("C9") = wb.Sheets(2).Range("C9").Value
wb.Sheets(4).Range("D9") = wb.Sheets(2).Range("G9").Value
wb.Sheets(4).Range("E9") = wb.Sheets(2).Range("H9").Value
wb.Sheets(4).Range("F9") = wb.Sheets(2).Range("I9").Value
wb.Sheets(4).Range("G9") = wb.Sheets(2).Range("J9").Value
wb.Sheets(4).Range("H9") = wb.Sheets(2).Range("H5").Value
Case "212"
Sheets(4).Range("C11") = Sheets(2).Range("C9").Value
Sheets(4).Range("D11") = Sheets(2).Range("G9").Value
Sheets(4).Range("E11") = Sheets(2).Range("H9").Value
Sheets(4).Range("F11") = Sheets(2).Range("I9").Value
Sheets(4).Range("G11") = Sheets(2).Range("J9").Value
Sheets(4).Range("H11") = Sheets(2).Range("H5").Value
Case "180"
Sheets(4).Range("C14") = Sheets(2).Range("C9").Value
Sheets(4).Range("D14") = Sheets(2).Range("G9").Value
Sheets(4).Range("E14") = Sheets(2).Range("H9").Value
Sheets(4).Range("F14") = Sheets(2).Range("I9").Value
Sheets(4).Range("G14") = Sheets(2).Range("J9").Value
Sheets(4).Range("H14") = Sheets(2).Range("H5").Value
Case "230"
Sheets(4).Range("C7") = Sheets(2).Range("C9").Value
Sheets(4).Range("D7") = Sheets(2).Range("G9").Value
Sheets(4).Range("E7") = Sheets(2).Range("H9").Value
Sheets(4).Range("F7") = Sheets(2).Range("I9").Value
Sheets(4).Range("G7") = Sheets(2).Range("J9").Value
Sheets(4).Range("H7") = Sheets(2).Range("H5").Value
Case "192"
Sheets(4).Range("C8") = Sheets(2).Range("C9").Value
Sheets(4).Range("D8") = Sheets(2).Range("G9").Value
Sheets(4).Range("E8") = Sheets(2).Range("H9").Value
Sheets(4).Range("F8") = Sheets(2).Range("I9").Value
Sheets(4).Range("G8") = Sheets(2).Range("J9").Value
Sheets(4).Range("H8") = Sheets(2).Range("H5").Value
Case "149"
Sheets(4).Range("C10") = Sheets(2).Range("C9").Value
Sheets(4).Range("D10") = Sheets(2).Range("G9").Value
Sheets(4).Range("E10") = Sheets(2).Range("H9").Value
Sheets(4).Range("F10") = Sheets(2).Range("I9").Value
Sheets(4).Range("G10") = Sheets(2).Range("J9").Value
Sheets(4).Range("H10") = Sheets(2).Range("H5").Value
Case "196"
Sheets(4).Range("C12") = Sheets(2).Range("C9").Value
Sheets(4).Range("D12") = Sheets(2).Range("G9").Value
Sheets(4).Range("E12") = Sheets(2).Range("H9").Value
Sheets(4).Range("F12") = Sheets(2).Range("I9").Value
Sheets(4).Range("G12") = Sheets(2).Range("J9").Value
Sheets(4).Range("H12") = Sheets(2).Range("H5").Value
Case "190"
Sheets(4).Range("C13") = Sheets(2).Range("C9").Value
Sheets(4).Range("D13") = Sheets(2).Range("G9").Value
Sheets(4).Range("E13") = Sheets(2).Range("H9").Value
Sheets(4).Range("F13") = Sheets(2).Range("I9").Value
Sheets(4).Range("G13") = Sheets(2).Range("J9").Value
Sheets(4).Range("H13") = Sheets(2).Range("H5").Value
End Select
Worksheets("QAL_Ges").Range("C7:H14").Copy
Set wkbAus = Workbooks.Open("C:\Geradeauslauf\Q_Alarm\QAlarm_Ges.xls")
With wkbAus.Worksheets("Q_AlarmTL_Info")
.Range("R7:W14").PasteSpecial Paste:=xlValues, Paste:=xlFormats
.Range("A4").Activate
End With
lngLzeil = wb.Sheets("QA_DB").Range("D65536").End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False
Worksheets("Q_AlarmTL_Info").Range("W7:W14").Copy
With wb.Worksheets("QA_DB")
.Range(.Cells(lngLzeil, 4), .Cells(lngLzeil, 11)).PasteSpecial Paste:=Values
End With
Application.CutCopyMode = False
wkbAus.Close False
wb.Worksheets("Aus.Gr").Activate
End Sub


Bye

Nike
Anzeige
AW: Danke Nike
20.11.2003 13:42:12
marc
vielen dank fuer die schnelle antwort.

marc :o)
kürzerer Code?!
20.11.2003 14:12:18
IngoG
Hallo marc,
evt kannst Du deinen Code auch etwas verkürzen:

am Anfang zusätzlich ein

Dim C_row as integer

und dann den select ersetzen durch:

Select Case wb.Worksheets("Aus.Gr").Range("G5")
Case "350"
c_row=9
Case "212"
c_row=11
Case "180"

c_row=14
Case "230"
c_row=7
Case "192"
c_row=8
Case "149"
c_row=10
Case "196"
c_row=12
Case "190"
c_row=13
End Select
Sheets(4).Range("C"&C_ROW) = Sheets(2).Range("C9").Value
Sheets(4).Range("D"&C_ROW) = Sheets(2).Range("G9").Value
Sheets(4).Range("E"&C_ROW) = Sheets(2).Range("H9").Value
Sheets(4).Range("F"&C_ROW) = Sheets(2).Range("I9").Value
Sheets(4).Range("G"&C_ROW) = Sheets(2).Range("J9").Value
Sheets(4).Range("H"&C_ROW) = Sheets(2).Range("H5").Value

ist zwar nicht schneller, aber ...

Gruß INgo
Anzeige
AW: Danke INgo
21.11.2003 08:39:08
marc
hallo INgo,
vielen dank fuer deinen Vorschlag 'ne super Ergaenzung

marc :o)
Danke für die Rückmeldung oT
21.11.2003 12:20:10
IngoG
.

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige