Danke dir !!!
Denk ich las es jetzt so, solange es funktioniert bin ich zufrieden ))
Viele Grüße
Eugenia
Hallo Karnickel,
also hab es nun hinbekommen das es sogut wie fehlerfrei funktioniert. (Wie du gesagt hast probieren bringt einen weiter )
Viele Grüße
Eugenia
Hallo Erich,
ich danke dir für deine Antwort. Hoffe hattest nen schönen Urlaub!!!
Hab das Problem jetzt einigermassen hinbekommen und zwar so :
Sub Import_mit_Dialog()
Dim Quelle As Object, Ziel As Object
Dim Datei As String
'On Error GoTo Fehler
'Dialog „Datei öffnen“ anzeigen
Datei = Application.GetOpenFilename(„Excel-Dateien(*.xls),*xls“)
'Abbrechen falls keine Datei ausgewählt
If Datei = „Falsch“ Then
MsgBox „keine Datei ausgewählt“, , „Abbruch“
Exit Sub
End If
'MsgBox "Ausgewählte Datei: " & Datei, , „“
'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei
Set Quelle = ActiveWorkbook.Worksheets(1)
For idx = 1 To ThisWorkbook.Sheets.Count
Select Case idx
Case 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17 'hier die indexe der blätter eintragen, auf die eingefügt werden soll
Set Ziel = ThisWorkbook.Worksheets(idx)
'kopieren und einfügen
Quelle.Range(„B2“).Copy Destination:=Ziel.Range(„A12“) 'zu1
Quelle.Range(„C2:C16“).Copy Destination:=Ziel.Range(„B12:B26“)
Quelle.Range(„B17“).Copy Destination:=Ziel.Range(„A27“) 'zu2
Quelle.Range(„C17:C26“).Copy Destination:=Ziel.Range(„B27:B36“)
Quelle.Range(„B27“).Copy Destination:=Ziel.Range(„A37“) 'zu3
Quelle.Range(„C27:C36“).Copy Destination:=Ziel.Range(„B37:B46“)
Quelle.Range(„B37“).Copy Destination:=Ziel.Range(„A47“) 'zu4
Quelle.Range(„C37:C46“).Copy Destination:=Ziel.Range(„B47:B56“)
Quelle.Range(„B47“).Copy Destination:=Ziel.Range(„A57“) 'zu5
Quelle.Range(„C47:C56“).Copy Destination:=Ziel.Range(„B57:B66“)
Quelle.Range(„B57“).Copy Destination:=Ziel.Range(„A67“) 'zu6
Quelle.Range(„C57:C66“).Copy Destination:=Ziel.Range(„B67:B76“)
Quelle.Range(„B67“).Copy Destination:=Ziel.Range(„A77“) 'zu7
Quelle.Range(„C67:C76“).Copy Destination:=Ziel.Range(„B77:B86“)
Quelle.Range(„B77“).Copy Destination:=Ziel.Range(„A87“) 'zu8
Quelle.Range(„C77:C86“).Copy Destination:=Ziel.Range(„B87:B96“)
Quelle.Range(„B87“).Copy Destination:=Ziel.Range(„A97“) 'zu9
Quelle.Range(„C87:C96“).Copy Destination:=Ziel.Range(„B97:B106“)
Quelle.Range(„B97“).Copy Destination:=Ziel.Range(„A107“) 'zu10
Quelle.Range(„C97:C106“).Copy Destination:=Ziel.Range(„B107:B116“)
Quelle.Range(„B107“).Copy Destination:=Ziel.Range(„A117“) 'zu11
Quelle.Range(„C107:C116“).Copy Destination:=Ziel.Range(„B117:B126“)
End Select
Next idx
'ZellenOprimaleHoehe
ActiveWindow.SmallScroll Down:=-111
Rows(„12:126“).Select
Selection.Rows.AutoFit
ActiveWindow.SmallScroll Down:=3
Range(„C18“).Select
ActiveWorkbook.Close
'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing
Exit Sub
'Fehler:
Set Quelle = Nothing
Set Ziel = Nothing
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, „Fehler“
End Sub
Falls du Fehler siehst würde es mich freuen wenn du mir bescheid sagst.
Viele Grüße
Eugenia
Hallo Ralf,
darf ich dich wieder nerven.
Also ich hab nun ein anderes Problemchen.
Die Zellen Tabelle2!B12:B127 werden in den Zellen Tabelle2!F12:F127 mit grün, gelb und rot (g,y,r) bewertet.
Nun muss der Inhalt der (B)zellen die rot bewertet wurden automatisch in ein anderes Tabellenblatt kopiert werden und zwar in den den Bereich Tabelle3!B82:B97.
Ich weiss das in der Tabelle3 der Bereich um einiges kleiner ist, aber es dürften auch nicht so viele rotpunkte geben.
Steh voll aufm Schlauch und weiss nicht genau wie ich was sinnvolles raus bekommen kann.
Ich hoffe das ichs bisschen verständlich erklärt habe
Viele Grüße
Eugenia
Hallo!
Am besten wäre, wenn du mir deine Datei schickst, dann kann ich direkt darin umsetzen.
So muss ich mir immer zum Testen selbst zusammenbasteln…
Also Datei bitte an
[email protected]
gruß
ralf
Hallo Ralf,
also hab jetzt rumgetüftelt und mir überlegt dass ich dieses problem mit checkboxes lösen könnte.
Also in jeder zeile eine checkbox einbauen das das feld zB B12 in die Präsentation kopiert.
Muss nur noch schauen wie ich es schaffe das die begrenzte anzahl der Felder in der Präsentation nicht zum problem werden. Vllt mit so ner prüfung(Schleife) wenn zB zelle B82 in Präsentation nicht leer dann in die nächste zelle also B83 kopieren , oder so ähnlich.
Muss mal schauen ob ich den code soweit hinbekomme.
Was hälst du von meiner Idee?
Grüßle
Eugenia
Hallo
suche mal dort
http://www.herber.de/index.html
Gruss keymax
Oder zeichne es mal auf und du siehst mehr.