Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: 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
Anzeige

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
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige