vielleicht bin ich ja auch nur zu ungeduldig, aber ich versuch wirklich mein bestest um alleine klar zu kommen. Aber am Anfang fluppt das leider nicht immer. Ich habe heute schon mehrmals versucht eine Lösung für ein für Euch wahrscheinlich einfaches Problem zu finden.
Konkret möchte ich Werte aus einer Tabelle in zwei andere Tabellen übertragen. Mit dem folgenden Makro klappt das auch. Aber eines funktioniert nicht: Die Werte aus der der Ursprungstabelle werden immer komplett übertragen, auch die Zeilen in denen überhaupt keine Werte mehr stehen. Das ergibt dann Müll in den Zieltabellen. Ich poste Euch jetzt das gesamte Makro und makiere die entsprechenden Stellen mit !!!!HIER!!!
Sub DatenUebertrag()
Dim sFile As String, rng1 As Range, rng2 As Range, Zeilenzahl As Integer, intRow As Integer
Application.ScreenUpdating = False
sFile = Range("E33") & (".xls")
If Dir(sFile) = "" Then
MsgBox "Kann eine Datei mit dem angegebenen Pfad: " & Range("E33") & " nicht finden!" _
& vbLf & "Bitte überprüfen Sie den Namen und starten die Übertragung danach erneut."
End
Else
Workbooks.Open Filename:=sFile
End If
Set rng1 = Worksheets("Tabelle1").Range("A1:D300") '''HIER'''
Set rng2 = Worksheets("Tabelle1").Range("E1:H300") '''HIER!!!
Workbooks("Basis.xls").Activate
Worksheets("Kunden").Activate
ActiveSheet.Unprotect
intRow = 1
Do While Left(Cells(intRow, 1), 7) <> ""
intRow = intRow + 1
Loop
rng1.Copy !!!!ODER HIER!!!!!
Range(Cells(intRow, 4).Address).PasteSpecial Paste:=xlValues
ActiveSheet.Protect
Worksheets("Mitarbeiter").Activate
ActiveSheet.Unprotect
intRow = 1
Do While Left(Cells(intRow, 1), 7) <> ""
intRow = intRow + 1
Loop
rng2.Copy !!!!!bzw.HIER!!!!
Range(Cells(intRow, 5).Address).PasteSpecial Paste:=xlValues
ActiveSheet.Protect
Application.ScreenUpdating = True
Debug.Print MsgBox("Die Monatswerte wurden erfolgreich übertragen", 0, "Datenübertragung")
Kill sFile
End Sub
Darf ich Euch hierzu deshalb noch einmal bemühen?
Gruß
Wolfgang