Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1184to1188
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

Zellen übertragen - Neuer Versuch bitte helft mir

Zellen übertragen - Neuer Versuch bitte helft mir
Rudi
Hallo, ich habe ein Problem!
Ich möchte, dass ein Macro folgendes macht:
Es soll von der Datei "C:\RSC 2011\Doppel_5er_4_Gruppen.xls" Zellen auslesen, die Datei "C:/RSC 2011/Teilnehmer.xls" öffen und die gelesenen Daten reinschreiben und die Datei "C:/RSC 2011/Teilnehmer.xls"wieder schließen.
Die Daten stehen, z. B., in der unten genannten Datei:
Lesen aus der Datei C:\RSC 2011\Doppel_5er_4_Gruppen.xls, Arbeitsblatt "Endspiel":
Die ID_Nr = steht in BG30:BG32, der dazugehörige Platz steht in der Spalte BC30:BC32.
(Die fett geschriebenen Zellen sind nur bei der oben angegebenen Datei gültig)
Bitte schreib mir als Kommentar an das Ende der Zeile wo ich genau die Zellen ändern ändern muß, damit das Macro, bei einer anderen Datei die zu kopierenden Zellen findet!
Die Daten sollen immer in der unten genannten Datei geschrieben werden:
Jetzt soll das Macro die Datei "C:/RSC 2011/Teilnehmer.xls" öffnenen, die ID_Nr suchen, die in der Spalte A steht und soll den Platz in die Zeile der gefundenen ID_Nr, in die Spalte L schreiben und die Datei "C:/RSC 2011/Teilnehmer.xls"wieder schließen.
Das war eigentlich schon alles, nur noch etwas, bitte schreibe mir in das Macro, hinter den jeweiligen Befehl, der die jeweiligen Daten aus der Datei "C:\RSC 2011\Doppel_5er_4_Gruppen.xls" ausliest, wie ich dies ändern kann, da es noch 19 andere Dateien gibt, wo die Daten in anderen Zellen sind aber immer in die Datei "C:\RSC 2011\Teilnehmer.xls" in die selben Spalten gesucht und geschrieben werden sollen!
Es wird dann jedes Macro individuell für jede Datei angepasst.
Denke bitte daran, dass ich überhaupt keine Ahnung von VBA habe!
Ich hoffe, ich habe mein Anliegen verständlich geschrieben!
Vielen lieben Dank schon mal von Rüdiger
PS.
Es gibt noch eine ähnliche Anfrage von Klaus, die aber bezieht sich auf seine Dateien und mit diesem Macro kann "ich" überhaupt nichts anfangen!

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zellen übertragen - Neuer Versuch bitte helft mir
17.11.2010 13:54:26
fcs
Hallo Rudi,
ich hab mal das Makro aus deiner früheren Anfrage angepasst, aber mangels Daten nicht getestet.
Anpassen muss du in jeder deiner Dateien "nur" den Namen des Blatts mit den Quelldaten und die beiden Zellbereiche für ID bzw. Platz.
Gruß
Franz
Option Explicit
Sub Uebertragen()
Dim oWB_EX As Workbook, varRow
Dim Zeile As Long
Dim booIsOpen As Boolean
Dim rngID As Range, rngPlatz As Range
Dim sDateiZiel As String, sBlattZiel As String
sDateiZiel = "D:\RSC\2011\Teilnehmer.xls"  'Name der Zieldatei
sBlattZiel = "Liste"                       'Name Zieltabelle in Zieldatei
'Prüfen, ob Zieldatei geöffnet und setzen von Variablen für Workbook und Offen-Status
Call Check_Open(sDateiZiel, oWB_EX, booIsOpen)
If oWB_EX Is Nothing Then Exit Sub 'Zieldatei konnte nicht zum Schreiben geöffnet werden.
'Datenbereich
With ThisWorkbook.Sheets("Endspiel") 'ggf. Name des Tabellenblatts mit Quelldaten anpassen
'beim Anpassen der Zellbereiche darauf achten, dass die Zeilennummern jeweils identisch  _
sind.
Set rngPlatz = .Range("BC30:BC32") 'Bereich mit Platz - ggf. anpassen
Set rngID = .Range("BG30:BG32")    'Bereich mit ID-Nr. - ggf. anpassen
End With
With oWB_EX
With .Sheets(sBlattZiel)
For Zeile = 1 To rngID.Rows.Count
'suche ID aus ID-Bereich in Spalte A (1) der Zieltabelle
varRow = Application.Match(rngID.Cells(Zeile, 1), .Columns(1), 0)
If IsNumeric(varRow) Then 'ID gefunden
'Wert aus Platz-Bereich in Spalte L (12) der Zieltabelle übertragen
.Cells(varRow, 12) = rngPlatz.Cells(Zeile, 1)
End If
Next
End With
.Save 'Ziel-Datei speichern
'Ziel-Datei schliessen, wenn sie nicht geöffnet war
If Not booIsOpen Then
.Close False 'schließen
End If
End With
End Sub
'Hilfsmakro um Datei zu suchen oder zu öffnen
Sub Check_Open(strFileFullName$, ByRef oWB_EX As Workbook, ByRef booIsOpen As Boolean)
Dim strFileName$, oWB As Workbook
strFileName = Right$(strFileFullName, Len(strFileFullName) - InStrRev(strFileFullName, "\"))
For Each oWB In Workbooks
If LCase(oWB.Name) = LCase(strFileName) Then
Set oWB_EX = oWB
End If
Next
If oWB_EX Is Nothing Then
If Dir(strFileFullName)  "" Then
Set oWB_EX = Workbooks.Open(strFileFullName)
If oWB_EX.ReadOnly Then
oWB_EX.Close False
Set oWB_EX = Nothing
End If
End If
Else
booIsOpen = True
End If
If Not oWB_EX Is Nothing Then _
If oWB_EX.ReadOnly Then Set oWB_EX = Nothing
If oWB_EX Is Nothing Then
MsgBox "Datei konnte nicht gefunden oder bearbeitet werden.", vbCritical
End If
End Sub

Anzeige
Danke
17.11.2010 18:44:40
Rudi
Hallo Franz, erst einmal vielen Dank, werde es in den nächsten Tagen ausprobieren!
Ich werde mich dann mit dem gleichen Betreff melden was passiert ist!
Vielen dank von Rüdiger

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige