Benötige Hilfe bei den Makros

[Lecruiser270]

Hallo Leute,

könntet ihr mir bitte bei der Umsetzung etwas zur Hilfe gehe?

1. Makro Löschen

Bei nachfolgenden Makro möchte ich gerne im letzten Bereich "Worksheets("Planeten+Monde")", dass dieses in einer Schleife abläuft. Die Schleife soll insgesamt 16 Mal ablaufen, beginnend von Spalte C bzw. D und soll jeweils eine Spalte dabei überspringen. Sprich von C auf E bzw. D auf F usw.

Code:

Sub ClearContents()
Worksheets("Accountdaten").Range("C7:H22").ClearContents
Worksheets("Accountdaten").Range("J7:L22").ClearContents
Worksheets("Accountdaten").Range("P5:P8").ClearContents

Worksheets("Ress+Projekte").Range("B4:E8").ClearContents
Worksheets("Ress+Projekte").Range("B13:E17").ClearContents
Worksheets("Ress+Projekte").Range("B33:E38").ClearContents
Worksheets("Ress+Projekte").Range("B22:B23").Value = 0
Worksheets("Ress+Projekte").Range("I4:I5,I10:I11,I16:I17,I22:I23,I28:I29,I34:I35,I40:I41,I46:I47").Value = 0
Worksheets("Ress+Projekte").Range("R5:T5,R11:T11,R17:T17,R23:T23,R29:T29,R35:T35,R41:T41,R47:T47").Value = 0

Worksheets("Planeten+Monde").Range("C8,C10,C12,C14,C17,C19,C21").ClearContents
Worksheets("Planeten+Monde").Range("D8,D10,D12,D14,D17,D19").Value = 100
Worksheets("Planeten+Monde").Range("C25:C27,C29:C32,C34:C37").ClearContents

End Sub

2. Daten aus einer anderen Tabelle einfügen.

Irgendwie stehe ich hier auf den Schlauch. Mittels Abfragenbutton soll der Tabellennutzer den Speicherort der alten Tabelle auswählen, da ich nicht weiß wo diese gespeichert und wie diese benannt ist. Danach soll automatisch die Datenübertragung ablaufen. @schauan war bereits so freundlich und hat mich auf Application.FileDialog(msoFileDialogFolderPicker) hingewiesen. Ich bin jetzt so weit gekommen, dass ich mir nach der Auswahl in einen Fenster den Speicherpfad anzeigen lassen kann....was nicht mein eigentliches Ziel ist.

Wenn beide Dateien am gleichen Ort gespeichert sind und ich die Benennungen kenne, würde es wie folgt aussehen:

Code:

  Workbooks("alteDatei.xls").Worksheets("Sheet1").Cells(x).Copy
  ActiveWorkbooks.Worksheets("Sheet1").Cells(x).Paste

Wie müsste das Makro im Grundaufbau aussehen, dass nach Auswahl der alten Datei durch den Anwender die Datenübertragung automatisch abläuft?

Am Ende müsste es doch auf vorgenannten Code zur Übertragung hinauslaufen, oder? Aber wie komme ich dahin? Insbesondere weil mir Pfad und Dateiname nicht bekannt sind.

[schauan]

Hallöchen,
Zur ersten Frage.:
Im Prinzip
For I = 3 To 35 Step 2
Cells(zeile,i)....
Next

Die Schleife startet mit 3, was dann bei Cells... Der Spalte C entspricht.

[Lecruiser270]

Zunächst einmal recht herzlichen Dank @schauan.

Ich bin bei der Datenübertragung von einer zur anderen Tabelle auf ein Problem gestoßen, ohne das ein Fehler entsteht. Ich wollte die Übertragung vereinfachen, indem ich dies mittels Schleife abarbeite. Es gibt keine Fehlermeldung, dennoch bleibt die Zielzelle leer.... Ich versteh das nicht.

Code:

Sub CommandButton1_Click() ' Daten importieren


Dim fileToOpen As Variant
Dim Firstbook As Object
Dim Secondbook As Object
Dim ZielZeile As Integer


' Festlegen der Zieldatei als Firstbook
Set Firstbook = ActiveWorkbook



' Auswahl der Quelldatei per "Datei öffnen Fenster"
ChDir ThisWorkbook.Path ' vordefiniertes Verzeichnis, in dem Dateien ausgewählt werden können
fileToOpen = Application.GetOpenFilename("Exceldateien (*.xlsx), *.xlsx")
Workbooks.Open Filename:=fileToOpen



' Festlegen der Quelldatei als Secondbook
Set Secondbook = ActiveWorkbook



' Eintragen der Werte in Zieldatei
With Firstbook.Sheets("Accountdaten")
    .Cells(7, 3).Value = Secondbook.Sheets("Accountdaten").Range("C6")
    .Cells(8, 3).Value = Secondbook.Sheets("Accountdaten").Range("C7")
    .Cells(9, 3).Value = Secondbook.Sheets("Accountdaten").Range("C8")
    .Cells(10, 3).Value = Secondbook.Sheets("Accountdaten").Range("C9")
    .Cells(11, 3).Value = Secondbook.Sheets("Accountdaten").Range("C10")
    .Cells(12, 3).Value = Secondbook.Sheets("Accountdaten").Range("C11")
    .Cells(13, 3).Value = Secondbook.Sheets("Accountdaten").Range("C12")
    .Cells(14, 3).Value = Secondbook.Sheets("Accountdaten").Range("C13")
    .Cells(15, 3).Value = Secondbook.Sheets("Accountdaten").Range("C14")
    .Cells(16, 3).Value = Secondbook.Sheets("Accountdaten").Range("C15")
    .Cells(17, 3).Value = Secondbook.Sheets("Accountdaten").Range("C16")
    .Cells(18, 3).Value = Secondbook.Sheets("Accountdaten").Range("C17")
    .Cells(19, 3).Value = Secondbook.Sheets("Accountdaten").Range("C18")
    .Cells(20, 3).Value = Secondbook.Sheets("Accountdaten").Range("C19")
    .Cells(21, 3).Value = Secondbook.Sheets("Accountdaten").Range("C20")
    .Cells(22, 3).Value = Secondbook.Sheets("Accountdaten").Range("C21")
   
    For I = 7 To 22 Step 1
    .Cells(I, 4).Value = Secondbook.Sheets("Accountdaten").Range("D6:D21")
    Next
   
End With

' Quelldatei schließen
Secondbook.Close


End Sub

Jede Zelle einzeln zu übertragen funktioniert einwandfrei. Wenn ich die ganzen Zeilen einer Spalte als Schleife übertragen lassen möchte, bleibt die Zieltabelle leer. Ist die Schleife falsch?

[Klaus-Dieter]

Hallo,


versuche es mal so:

Code:

For I = 7 To 22
    .Cells(I, 4) = Secondbook.Sheets("Accountdaten").Range("D" & I - 1).Value
    Next

[schauan]

Hallöchen,

das passt so nicht

Code:

    For I = 7 To 22 Step 1
    .Cells(I, 4).Value = Secondbook.Sheets("Accountdaten").Range("D6:D21")
    Next

Zum einen ist es recht umständlich, wenn man Daten 1:1 in einen anderen Bereich überträgt, das in einer Schleife zu tun.
Hier würde das reichen:
    .Range("D7:D22").Value = Secondbook.Sheets("Accountdaten").Range("D6:D21")

Zum anderen, wenn Du so etwas zellenweise in einer Schleife tust, musst Du hier auch zellenweise die Quelldaten auslesen, also
    .Cells(I, 4).Value = Secondbook.Sheets("Accountdaten").Cells(I-1, 4)

[Lecruiser270]

Damit haben Sich meine Probleme und Fragen erledigt.

Herzlichen Dank @ all