Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
216to220
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
216to220
216to220
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Set Range > Copy

Set Range > Copy
13.02.2003 22:55:31
Wolfgang
Hallo,
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


4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Set Range > Copy
13.02.2003 23:35:16
udo

Servus Wolfi, ich weis jetzt nicht ob dir das hier weiter hilft , bin leider auch kein VBA Profi , aber bei mir hatte ich glaube ich ein ähnliches Problem, und in meiner Tabelle wird die erste Tabelle vor der Datenübernahme mit einem Autofilter in der entsprechenden Spalte zuerst auf alle " Nichtleeren Werte " gefiltert und dann erst rüberkopiert. Somit entfallen dann in der anderen tabelle die leeren zellen.

Selection.AutoFilter Field:=1, Criteria1:="<>"

vielleicht hilfts, Gruß udo


Re: Set Range > Copy
13.02.2003 23:55:03
Melanie Dierks

Hallo Wolfgang,

füge einfach in Deinen Code bei "PaseSpecial:=xlValues, SkipBlanks:=True" ein und es funtioniert, was Du möchtest.
Denn SkipBlanks entscheidet, ob auch die leeren Zellen eingefügt werden.

Gruß Melanie

Anzeige
Re: Set Range > Copy
13.02.2003 23:56:32
Wolfgang

Hi Udo,
ich versuchs einfach mal. Danke auf jeden Fall.
Gruß
Wolfgang

Re: Set Range > Copy
13.02.2003 23:58:37
Wolfgang

Hi Melanie,
hört sich echt gut an. Ich probiers auf jeden Fall aus. Danke für die Antwort.
Gruß
Wolfgang

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige