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

Werte per Abfrage Übertragen

Werte per Abfrage Übertragen
21.02.2008 18:22:00
steffi
Hallo Zusammen,
ich brauche mal etwas Pflege, das ganze Funktioniert ja auch gut, nur brauche ich noch Daten aus 2 weiteren Tabellen. Siehe Datei.
Vielleicht kann mir jemand Schreiben wie ich das alleine Bewältige, weitere Tabellen einzupflegen.
https://www.herber.de/bbs/user/50086.xls
Gruß und Danke
Steffi

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte per Abfrage Übertragen
21.02.2008 22:22:00
Josef
Hallo Steffi,
probier mal.
Sub Uebertrag()
Dim objWS As Worksheet
Dim rng As Range
Dim lngR As Long
Dim intMonth As Integer

intMonth = Application.InputBox("Bitte Monat angeben: (1 - 12)", "Monat", Month(Date), Type:=1)

If intMonth < 1 Or intMonth > 12 Then
    MsgBox "Eingabe ungültig!", vbInformation, "Fehler"
    Exit Sub
End If

With Range("Übertrag")
    
    .ClearContents
    .Interior.ColorIndex = 36
    
    For Each objWS In ThisWorkbook.Worksheets
        If objWS.Name Like "Dateneingabe*" Then
            For Each rng In objWS.Range("A4:A25")
                If rng <> "" Then
                    If IsDate(rng) Then
                        If Month(rng) = intMonth Then
                            lngR = lngR + 1
                            If lngR > .Rows.Count Then
                                MsgBox "Zu viele Daten!", vbInformation, "Hinweis"
                                Exit Sub
                            End If
                            .Cells(lngR, 1) = rng.Value
                            .Cells(lngR, 2) = rng.Offset(0, 1).Value
                            .Rows(lngR).Interior.ColorIndex = rng.Interior.ColorIndex
                        End If
                    End If
                End If
            Next
        End If
    Next
    
End With

End Sub


Gruß Sepp



Anzeige
AW: Werte per Abfrage Übertragen
22.02.2008 18:12:00
steffi
Hallo,
wenn ich den Code Eingabe bzw. Kopiere erhalte ich eine Fehlermeldung:
Excel kann das Macro 'uebertrag2'.xls!Modul1.uebertrag nicht finden.
Ist da was falsch ?.
Gruß und Danke
Steffi
Code:

Sub Uebertrag()
Dim objWS As Worksheet
Dim rng As Range
Dim lngR As Long
Dim intMonth As Integer
intMonth = Application.InputBox("Bitte Monat angeben: (1 - 12)", "Monat", Month(Date), Type:=1)
If intMonth  12 Then
MsgBox "Eingabe ungültig!", vbInformation, "Fehler"
Exit Sub
End If
With Range("Übertrag")
.ClearContents
.Interior.ColorIndex = 36
For Each objWS In ThisWorkbook.Worksheets
If objWS.Name Like "Dateneingabe*" Then
For Each rng In objWS.Range("A4:A25")
If rng  "" Then
If IsDate(rng) Then
If Month(rng) = intMonth Then
lngR = lngR + 1
If lngR > .Rows.Count Then
MsgBox "Zu viele Daten!", vbInformation, "Hinweis"
Exit Sub
End If
.Cells(lngR, 1) = rng.Value
.Cells(lngR, 2) = rng.Offset(0, 1).Value
.Rows(lngR).Interior.ColorIndex = rng.Interior.ColorIndex
End If
End If
End If
Next
End If
Next
End With
End Sub


Anzeige
AW: Werte per Abfrage Übertragen
23.02.2008 13:20:09
Josef
Hallo Steffi,
du musst der Schaltfläche das richtige Makro zuweisen.

Gruß Sepp



Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige