Daten auslesen & Übertragen

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Daten auslesen & Übertragen

Daten auslesen & Übertragen von Bernd vom 26.07.2014 05:41:42

AW: Daten auslesen & Übertragen - von Oberschlumpf am 26.07.2014 07:49:07
- AW: Daten auslesen & Übertragen - von Bernd am 26.07.2014 09:03:08
  - AW: Daten auslesen & Übertragen - von Oberschlumpf am 26.07.2014 09:10:33
    - @ Thorsten : 1000 DANK, exakt das wollte ich! owT - von Bernd am 26.07.2014 10:06:14
- AW: Daten auslesen & Übertragen - von Bernd am 26.07.2014 09:03:28
Nachtrag - VBA Codeänderung - von Bernd am 26.07.2014 10:30:27
- AW: Nachtrag - VBA Codeänderung - von Hajo_Zi am 26.07.2014 11:21:57
  - AW: Nachtrag - VBA Codeänderung - von Bernd am 26.07.2014 12:08:17
    - AW: Nachtrag - VBA Codeänderung - von Hajo_Zi am 26.07.2014 12:18:31
      - AW: Nachtrag - VBA Codeänderung - von Bernd am 26.07.2014 12:23:34
- AW: Nachtrag - VBA Codeänderung - von Oberschlumpf am 26.07.2014 17:02:39
  - AW: Nachtrag - VBA Codeänderung - von Bernd am 27.07.2014 05:26:43
    - AW: Nachtrag - VBA Codeänderung - von Oberschlumpf am 27.07.2014 08:46:56

Betrifft: Daten auslesen & Übertragen von: Bernd
Geschrieben am: 26.07.2014 05:41:42

Wunderschönen guten morgen liebe Excelgemeinde!

Bin da wieder mal an meine Grenzen gestossen und Bitte um Eure Hilfe.

Ich habe eine Arbeitsmappe mit knapp über 500 Tabellenblätter die alle exakt gleich aufgebaut sind.

SERGE hat mir damit bereits geholfen wo ich nachstehenden VBA Code erhalten habe:

~

Sub Name()
    ActiveSheet.Unprotect
Application.ScreenUpdating = False
Dim WS As Worksheet
    Dim X As Integer
    Dim Y As Integer
    Set WS = ActiveSheet
    For X = 1 To ActiveWorkbook.Worksheets.Count
        For Y = X To ActiveWorkbook.Worksheets.Count
            If Worksheets(Y).Name < Worksheets(X).Name Then
                Worksheets(Y).Move Before:=Worksheets(X)
            End If
        Next Y
    Next X
    WS.Activate
    Set WS = Nothing
Dim i As Integer
For i = 1 To Worksheets.Count
   Cells(i, 1) = Sheets(i).Name
   ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:= _
      "'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
Next 'i
    Columns("A:A").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
    Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
    Application.GoTo Reference:="R3C1"
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Dim WsShell, intText As Integer
    Set WsShell = CreateObject("WScript.Shell")
    intText = WsShell.Popup("Inhalt neu aufgelistet - - -  Hinweis wird automatisch nach 3  _
Sekunden geschlossen!!!", 3, "Huhu ...")
 End Sub

~

Nun zu meinen Anliegen:

Ist es möglich den Code so zu verändern dass bei den aufgelisteten Blattnamen zusätzlich die Inhalte des Tabellenblattes der Zellen B2 und S2 mit aufgelistet wird?

Hoffe ich habe es Verständlich erklärt, danke schon mal vorab für jegliche Hilfe und wünsche einen sonnigen ruhigen Samstag.

lg Bernd

Betrifft: AW: Daten auslesen & Übertragen von: Oberschlumpf
Geschrieben am: 26.07.2014 07:49:07

Hi Bernd,

versuch mal (ungetestet)

   ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:= _
      "'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name & " " & Cells(2,2).Value & "  _
" & Cells(2,14).Value

Hilfts?

Wenn nicht, dann zeig ma ne Bsp-Datei.

Ciao
Thorsten

Betrifft: AW: Daten auslesen & Übertragen von: Bernd
Geschrieben am: 26.07.2014 09:03:08

Hi Thorsten!

Danke für Deine Antwort, komme aber damit ohnehin nicht zurecht und habe mal eine kleine Datei nachgebastelt um es leichter verstehen zu können:

https://www.herber.de/bbs/user/91731.xlsm

Habe in der Datei nochmals erwähnt, wie ich was haben möchte.

Danke im Voraus und lg wünscht Bernd

Betrifft: AW: Daten auslesen & Übertragen von: Oberschlumpf
Geschrieben am: 26.07.2014 09:10:33

Hi Bernd

Meinst du so:
https://www.herber.de/bbs/user/91732.xlsm

Hilfts?

Ciao
Thorsten

Betrifft: @ Thorsten : 1000 DANK, exakt das wollte ich! owT von: Bernd
Geschrieben am: 26.07.2014 10:06:14

Betrifft: AW: Daten auslesen & Übertragen von: Bernd
Geschrieben am: 26.07.2014 09:03:28

Hi Thorsten!

Danke für Deine Antwort, komme aber damit ohnehin nicht zurecht und habe mal eine kleine Datei nachgebastelt um es leichter verstehen zu können:

https://www.herber.de/bbs/user/91731.xlsm

Habe in der Datei nochmals erwähnt, wie ich was haben möchte.

Danke im Voraus und lg wünscht Bernd

Betrifft: Nachtrag - VBA Codeänderung von: Bernd
Geschrieben am: 26.07.2014 10:30:27

Hi nochmals!

Bin sehr zufrieden mit der Lösung von Thorsten und habe sie bereits eingearbeitet und verändert wie ich es brauchte.

Leider bin ich nicht in der Lage, den VBA Code so zu ändern, dass die Auflistung nicht ab Zelle A1, sondern ab Zelle A4 beginnt.

Ich vermute das dies geändert gehört: Columns("A:A").Select

Aber wie gesagt, ich vermute nur, hab zwar herum probiert, aber eben ohne Erfolg, so wie immer :-(

Brauche deshalb noch einmal ein Excelgenie, der mir sagt, was ich ändern muss.

Nochmals tausend Dank für die bisherige Hilfe und Gruss aus Klagenfurt wünscht

Bernd

Betrifft: AW: Nachtrag - VBA Codeänderung von: Hajo_Zi
Geschrieben am: 26.07.2014 11:21:57

Hallo Bernd,

Select, Activate usw. ist in VBA zu 99,9% nicht notwendig.
Der Cursor ist kein Hund der überall rumgeführt werden muss.
Hinweise zu select usw. Hajo-Excel.de
Hinweise zu select usw. Online-Excel.de
Hinweise zu select usw. Online-Excel.de

nur
With Range("A4:A" & Rows.Count).Font

Grußformel

Betrifft: AW: Nachtrag - VBA Codeänderung von: Bernd
Geschrieben am: 26.07.2014 12:08:17

Hallo Hajo!

Egal wie ich es probiere und Deinen Vorschlag reinkopiere, es geht einfach nicht. Es wird IMMER ab Zelle A1 aufgelistet.

Benötige deshalb noch weiter Hilfe und zwar so, dass auch ich als "Dummy" es verstehe.

Danke und lg wünscht

Bernd

Betrifft: AW: Nachtrag - VBA Codeänderung von: Hajo_Zi
Geschrieben am: 26.07.2014 12:18:31

ich hätte vermutet es geht um diesen Code

Columns("A:A").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With

da lag ich dann wohl falsch und bin raus.

Gruß Hajo

Betrifft: AW: Nachtrag - VBA Codeänderung von: Bernd
Geschrieben am: 26.07.2014 12:23:34

Hi Hajo!

Naja, ich auch, aber bin kein Profi. Es wird sich aber sicher jemand finden, der mit weiter helfen kann.

Trotzdem Danke für Deine Müh und Not um mir zu Helfen.

lg Bernd

Betrifft: AW: Nachtrag - VBA Codeänderung von: Oberschlumpf
Geschrieben am: 26.07.2014 17:02:39

Hi Bernd

versuch mal
https://www.herber.de/bbs/user/91739.xlsm

Wenn ich dich richtig verstanden habe, liegt/lag dein Problem in der For/Next-Schleife, die so beginnt:

For i = 1 To Worksheets.Count
   Cells(i, 1) = Sheets(i).Name
...usw
Next i

Bei allen i's, die einem Cells( folgen, muss man ein + 3 anhängen, sieht dann so aus:

For i = 1 To Worksheets.Count
   Cells(i + 3, 1) = Sheets(i).Name
...usw
Next i

Die For-Schleife beginnt ja mit 1, weil du alle Sheets mit einbeziehen willst.
Wenn du i nun aber auch als Zeile verwendest, wird ja logischerweise auch bei 1 begonnen.
Deswegen überall, wo es hingehört, ein + 3, und alles is gut :-)

Hilfts?
(mach dir ruhig mal die Mühe, Erfolgsmeldungen ins eigentliche Antwortfeld zu schreiben.
Ich schreib den Text hier ja auch nicht nur ins Betrefffeld)

Ciao
Thorsten

Betrifft: AW: Nachtrag - VBA Codeänderung von: Bernd
Geschrieben am: 27.07.2014 05:26:43

Guten morgen Thorsten!

Zuerst einmal, recht herzlichen Dank, Du hast es genau getroffen und dieses Mal ist es so, wie von mir angedacht war. Weiters bedanke ich mich bei Dir, für Deine wirklich logisch und verständliche Erklärung (machen ja nicht viele).

Wie ich ja geschrieben habe, habe ich ja selbst versucht es hinzubekommen, ist ja leider gescheitert.

Witzigerweise habe ich auch hier probiert:

~For i = 1 To Worksheets.Count
Cells(i, 1) = Sheets(i).Name
...usw
Next i~

Da aber mein Wissen im VBA fehlte hatte ich es so probiert:

~For i = 1 To Worksheets.Count
Cells(i, 3) = Sheets(i).Name
...usw
Next i~ (also die 3 hatte ich aufgrund der Logik)

Dass es aber so heissen soll:

~For i = 1 To Worksheets.Count
Cells(i + 3, 1) = Sheets(i).Name
...usw
Next i~

da konnte ich nicht drauf kommen. Aber Dank Deiner Mühevollen Erklärung, habe ich es geistig verarbeitet und hoffe, ich merke es mir auch.

Abschliessend möchte ich SORRY sagen, wenn es Dich erzürnt hat, dass ich die Erfolgsmeldung für Dich nur kurz und nicht hier geschrieben habe. Auch dass wurde von mir im KOpf abgespeichert und wird mir NIE mehr passieren.

Danke nochmals für die Hilfen (auch der anderen), ich bin froh das alles funktioniert und wünsche allen einen schönen Sonntag (der hoffentlich sonnig und nicht regenerisch wie hier in Klagenfurt ist).

lg Bernd

Betrifft: AW: Nachtrag - VBA Codeänderung von: Oberschlumpf
Geschrieben am: 27.07.2014 08:46:56

Moin Bernd

sorry, nun zick ma nich so rum.
Dein Beitrag kommt größtenteils ironisch rüber.

Wenn du nich mehr willst, dass auch ich versuche, dir zu helfen, schreib es ruhig.
Jedenfalls glaub ich, so etwas zwischen den Zeilen zu lesen.

Wir geben uns echt oft große Mühe zu helfen.
Wenn dann aber nur im Betreff steht "danke, passt..owT", dann is das schon nich so schön.

Bedenke mal, dass du nix für die Lösungstreffer zahlen musst.

Ciao
Thorsten

..ach ja, dein Versuch, die 3 einzusetzen, ändert nur die zu benutzende Spalte...