Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1128to1132
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
Inhaltsverzeichnis

Daten per VBA kopieren mit 2 Kreterien

Daten per VBA kopieren mit 2 Kreterien
Jan
Hallo, ich hab folgendes Problem und bitte um hilfe:
Ich verwende eine Datei mit ca. 20 fest benamten Tabellenblättern.
Im ersten Blatt ist eine Matrix in der im Bereich b2:b21 die Namen der Tabellenblätter untereinander stehen.
In Spalte c2:c21 wird nach Bedarf etwas eingetragen.
In Zelle E1 ist die Formel Heute() eingetragen
Alle anderen Tabellenblätter haben in Spalte A4:A30 jeweils das Tagesdatum des laufenden Monats untereinander. B4:B34 ist der Zielbereich für die aus Tabellenblatt1 kommenden Daten (hier C?)
Ziel soll sein per Macro die Daten aus Tabellenblatt 1 in das zugehörige Tabellenblatt und dort in die Zeile einzutragen, die das gleiche Datum hat wie im Tabellenblatt 1 E1.
Anders ausgedrückt : Finde das richtige tabellenblatt, vergleiche dann das Datum und kopiere die Daten aus c zum richtigen Datum in die Zelle B?
Ich hoffe mir kann jemand helfen
Dank vorab
Gruß
Jan

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

Betreff
Benutzer
Anzeige
AW: Daten per VBA kopieren mit 2 Kreterien
08.01.2010 22:13:28
Josef
Hallo Jan,
na dann probier mal.
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub copyData()
  Dim rng As Range
  Dim vntRet As Variant
  
  With Sheets(1)
    For Each rng In .Range("B2:B21")
      If rng <> "" And rng.Offset(0, 1) <> "" Then
        If SheetExist(rng.Text) Then
          vntRet = Application.Match(.Range("E1"), Sheets(rng.Text).Range("A4:A30"), 0)
          If IsNumeric(vntRet) Then
            Sheets(rng.Text).Cells(vntRet + 3, 2) = rng.Offset(0, 1).Value
          End If
        End If
      End If
    Next
  End With
  
End Sub

Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If wks.Name = sheetName Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function

Gruß Sepp

Anzeige
AW: Daten per VBA kopieren mit 2 Kreterien
08.01.2010 22:27:18
Jan
Hallo Sepp,
Klappt super, vielen Dank
Gruß Jan
AW: Daten per VBA kopieren mit 2 Kreterien
08.01.2010 22:27:41
Jan
Hallo Sepp,
Klappt super, vielen Dank
Gruß Jan

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige