Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
712to716
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
712to716
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kopieren

Kopieren
25.12.2005 14:14:46
Walter
Guten Tag Zusammen,
ich wünsche ALLEN Forumsteilnehmern, ein frohes Fest !
Ich habe folgendes Problem:
In der Mappe "Werkstatt" Spalte "B" ab Zelle 4 soll der Inhalt (W04)in die Mappe
"Werkbank" in die Spalte "B" ab Zelle 7 kopiert werden.
Hinweis in der Mappe Werkstatt wird das Ende der Spalte "B" durch die Spalte
"A" festgelegt, da hier die laufende Nr. steht., ferner ist nicht jede Zelle
der Spalte "B" belegt, es sollen also nacheinander Werte in die Mappe
"Werkbank" angefangen von Zelle 7 kopiert werden.
mit freundlichen Gruß Walter

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren
25.12.2005 15:10:44
Josef Ehrensberger
Hallo Walter!
Kannst du eine Beispielmappe hochladen?
Mit einigen Relevanten Daten und der Kennzeichnung, was, wann und wohin kopiert werden soll!
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Kopieren
25.12.2005 15:22:11
Walter
Hallo Josef,
Danke für die Unterstützung am heiligen 2. Weihnachtstag.
Anbei das Muster:

Die Datei https://www.herber.de/bbs/user/29536.xls wurde aus Datenschutzgründen gelöscht

Also es sollen die Daten von der Spalte "B" in die "Werkbank" Mappe angefangen von Zeile
7 nacheinander kopiert werden.
Bis später,
gruß Walter
Anzeige
AW: Kopieren
25.12.2005 16:48:20
et999
Hi Walter,
ich denke so müsste es klappen:
Dim ZeilenCop As Integer
Dim ZeilenPas As Integer
ZeilenPas = 7
Sheets("Haus").Select
For ZeilenCop = 4 To ActiveSheet.UsedRange.Rows.Count
If Cells(ZeilenCop, 2) <> "" Then
Range("Werkbank!B" & ZeilenPas).Value = _
Cells(ZeilenCop, 2).Value
ZeilenPas = ZeilenPas + 1
End If
Next
Gruß
Uwe
(:o)
Danke Uwe
25.12.2005 17:17:33
Walter
Hallo Uwe,
auch DEIN Vorschlag funktioniert.
Danke und schönes Fest noch...
gruß Walter
AW: Kopieren
25.12.2005 17:02:37
Josef Ehrensberger
Hallo Walter!
Etwa so?
https://www.herber.de/bbs/user/29537.xls
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
Danke noch eine Frage dazu ...
25.12.2005 17:21:44
Walter
Hallo Sepp,
wie was von Dir kommt funktioniert.
Ich möchte, wenn das geht, das alle vorhandenen Zeilen gelöscht werden, außer die
Zeile 7+8,, will dann immer eine Zeile dazwischen schieben und zwar bis zur Spalte 15,
da es eine Datenbank wird ich ich in den nächsten Zellen Funktionen hinterlege.
Gruß Walter
AW: Danke noch eine Frage dazu ...
25.12.2005 17:59:54
Josef Ehrensberger
Hallo Walter!
Dann Probier's so!
Sub KopiereDaten1()
Dim varArray As Variant
Dim lngLast As Long
Dim intCount As Integer, intIndex As Integer, intItem As Integer

lngLast = Sheets("Haus").Range("A65536").End(xlUp).Row
Sheets("Werkbank").Range("B7:B100").ClearContents
varArray = Sheets("Haus").Range("B4:B" & lngLast)

intIndex = 7

With Sheets("Werkbank")
  For intCount = 1 To UBound(varArray, 1)
    If varArray(intCount, 1) <> "" Then
      intItem = intItem + 1
      .Cells(intIndex, 1) = intItem
      .Cells(intIndex, 2) = varArray(intCount, 1)
      intIndex = intIndex + 2
    End If
  Next
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
Entschuldigung
25.12.2005 18:15:12
Walter
Hallo Sepp,
Entschuldigung, habe mich Falsch ausgerdückt.
In der Spalte 3-18 stehen Formeln, die Bezug auf die kopierte Spalte nehmen.
Ich möchte nur so viel Zeilen haben wie ich brauche. Und der Druckbereich verlängert
sich etc..
Deshalb brauche ich nicht in der Spalte "b" sondern angefangen ab Zeile 8 verschieben von Spalte 3 bis 18. Dann sollen ja die Formeln aus der Zeile 8 nach unten kopiert werden.
Wenn das zuviel aufwand ist, sage es bitte,
gruß Walter
3-18
AW: Entschuldigung
25.12.2005 18:54:01
Josef Ehrensberger
Hallo Walter!
Kein Problem, das kriegen wir schon hin;-))
Sub KopiereDaten1()
Dim varArray As Variant
Dim lngLast As Long
Dim intCount As Integer, intIndex As Integer, intItem As Integer

lngLast = Sheets("Haus").Range("A65536").End(xlUp).Row
Sheets("Werkbank").Range("A9:R100").ClearContents
varArray = Sheets("Haus").Range("B4:B" & lngLast)

intIndex = 7

With Sheets("Werkbank")
  For intCount = 1 To UBound(varArray, 1)
    If varArray(intCount, 1) <> "" Then
      intItem = intItem + 1
      .Cells(intIndex, 1) = intItem
      .Cells(intIndex, 2) = varArray(intCount, 1)
      .Range(.Cells(8, 3), .Cells(8, 18)).Copy .Range(.Cells(intIndex + 1, 3), .Cells(intIndex + 1, 18))
      intIndex = intIndex + 2
    End If
  Next
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
Das ist ja wie Weihnachten...
25.12.2005 19:43:04
Walter
Hallo Sepp,
habe noch etwas angepaßt, da immer noch eine Leerzeile war, funktiniert aber jetzt !!!
Selbst die Nummerierung läuft ja in der Spalte "A" !!!
Die letzte Zeile nach dem kopieren müßte noch gelöscht werden, aber WIE ?
Z.B. steht bei mir die Zeile 35 als letztes Voll aber die Zeile 36 ist ab Spalte 3-18 kopiert, kann man die wegmachen ?
Bitte nicht schimpfen... kannst Du mir mal das da hinter Schreiben was passiert?
Ich möchte mal was lernen !
Gruß Walter
AW: Das ist ja wie Weihnachten...
25.12.2005 20:01:34
Josef Ehrensberger
Hallo Walter!
Ich weis jetzt nicht, ob ich dich richtig verstanden habe!
Sub KopiereDaten1()
Dim varArray As Variant
Dim lngLast As Long
Dim intCount As Integer, intIndex As Integer, intItem As Integer

On Error GoTo ErrExit
' Fehlerbehandlung

With Application
  ' Excel "Ruhigstellen"
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
  .DisplayAlerts = False
End With

lngLast = Sheets("Haus").Range("A65536").End(xlUp).Row
' Letzte gefüllte Zeile in Spalte "A" ermitteln

Sheets("Werkbank").Range("A9:R100").ClearContents
' Zielbereich löschen

varArray = Sheets("Haus").Range("B4:B" & lngLast)
' Datenbereich in Array einlesen

intIndex = 7
' Startzeile für Datenübername

With Sheets("Werkbank")
  
  For intCount = 1 To UBound(varArray, 1)
    ' Arrayeinträge durchlaufen
    
    If varArray(intCount, 1) <> "" Then
      ' Wenn Eintrag vorhanden
      
      intItem = intItem + 1
      ' Zähler für Nummerierung hochzählen
      
      .Cells(intIndex, 1) = intItem
      ' Nummerierung
      .Cells(intIndex, 2) = varArray(intCount, 1)
      ' Daten in Spalte "B" schreiben
      
      If intCount < UBound(varArray, 1) Then
        ' Beim letzten Eintrag Formelzeile NICHT kopieren ?
        
        .Range(.Cells(8, 3), .Cells(8, 18)).Copy .Range(.Cells(intIndex + 1, 3), .Cells(intIndex + 1, 18))
        ' Zeile acht kopieren und in Zeile unterhalb der Daten einfügen
        
      End If
      
      intIndex = intIndex + 2
      ' Zeilenzähler hochzählen
      
    End If
    
  Next
  
End With

ErrExit:
' Fehlerbehandlung

With Application
  ' Excel wieder "Scharfstellen"
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
  .DisplayAlerts = True
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Das ist ja wie Weihnachten...
25.12.2005 20:21:35
Walter
Hallo Sepp,
also bis Zeile 35 sind Daten aber in Zeile 36 von Spalte3-18 sind die Daten noch kopiert,
ich möchte die kompl.Zeile mit Formatierung löschen.
Gruß Walter
AW: Das ist ja wie Weihnachten...
25.12.2005 21:26:55
Josef Ehrensberger
Hallo Walter!
Ganz klar ist mir das ganze immer noch nicht!
Der Bereich wird doch vorher geleert, das steht doch nichts mehr!
Egal, probier's mal so.
Sub KopiereDaten1()
Dim varArray As Variant
Dim lngLast As Long
Dim intCount As Integer, intIndex As Integer, intItem As Integer

On Error GoTo ErrExit
' Fehlerbehandlung

With Application
  ' Excel "Ruhigstellen"
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
  .DisplayAlerts = False
End With

lngLast = Sheets("Haus").Range("A65536").End(xlUp).Row
' Letzte gefüllte Zeile in Spalte "A" ermitteln

Sheets("Werkbank").Range("A9:R100").ClearContents
' Zielbereich löschen

varArray = Sheets("Haus").Range("B4:B" & lngLast)
' Datenbereich in Array einlesen

intIndex = 7
' Startzeile für Datenübername

With Sheets("Werkbank")
  
  For intCount = 1 To UBound(varArray, 1)
    ' Arrayeinträge durchlaufen
    
    If varArray(intCount, 1) <> "" Then
      ' Wenn Eintrag vorhanden
      
      intItem = intItem + 1
      ' Zähler für Nummerierung hochzählen
      
      .Cells(intIndex, 1) = intItem
      ' Nummerierung
      .Cells(intIndex, 2) = varArray(intCount, 1)
      ' Daten in Spalte "B" schreiben
      
      If intCount < UBound(varArray, 1) Then
        ' Beim letzten Eintrag Formelzeile NICHT kopieren ?
        
        .Range(.Cells(8, 3), .Cells(8, 18)).Copy .Range(.Cells(intIndex + 1, 3), .Cells(intIndex + 1, 18))
        ' Zeile acht kopieren und in Zeile unterhalb der Daten einfügen
      Else
        ' Nach letzter Datenzeile alles löschen
        
        .Range(.Cells(intIndex + 1, 1), .Cells(.Rows.Count, 18)).Clear
        
      End If
      
      intIndex = intIndex + 2
      ' Zeilenzähler hochzählen
      
    End If
    
  Next
  
End With

ErrExit:
' Fehlerbehandlung

With Application
  ' Excel wieder "Scharfstellen"
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
  .DisplayAlerts = True
End With

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
Hallo noch einmal..
26.12.2005 12:33:25
Walter
Guten Tag Sepp,
habe alles eingesetzt, funktioniert so wie ich das möchte. Habe folgende Zeile angefügt:
Dim z
z = Range("A9").End(xlDown).Row
ActiveSheet.Range(Cells(z + 1, 1), Cells(z + 1, 1)).Select '1.Spalte nach unten
ActiveSheet.Range(Cells(z + 1, 1), Cells(z + 1, 18)).Select
Selection.Delete Shift:=xlUp
Das Funktioniert.
Kannst Du mir noch einmal behilflich sein, ich möchte gern die Zeilen ändern das das Ende
in der Spalte "C" erreicht wird bis "04" steht.
z = Range("C7").End(xlDown).Row << hier müßte doch irgenwie der Hinweis rein oder ?
Gruß Walter
Anzeige
AW: Hallo noch einmal..
26.12.2005 18:04:52
Josef Ehrensberger
Hallo Walter!
Poste bitte den kompletten Code, so wie du ihn jetzt verwendest, und
beschreibe etwas genauer was du willst!
Sonst wird das ein Ratespiel;-)
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Hallo noch einmal..
26.12.2005 18:44:12
Walter
Hallo Sepp,
das Makro funktioniert so einwandfrei. Ich laß das so wie Du es vorgeschlagen hast.
Gruß Walter
Anzeige
AW: Kopieren
25.12.2005 17:04:32
Harald
Hallo Walter,
mit diesem Code müsste es gehen:
Dim Schleife As Integer
Schleife = 4
While Worksheets("Haus").Range("A" & Schleife).Value <> ""
Worksheets("Haus").Range("B" & Schleife).Copy _
Destination:=Worksheets("Werkbank").Range("B" & Schleife + 3)
Schleife = Schleife + 1
Wend
M.f.G.
Harald
Hallo ...
25.12.2005 17:27:55
Walter
Hallo Harald,
funktioniert, allerdings sind auch die Leerzeilen mit kopiert.
Ansonsten schon O.K.,
werde noch ein wenig rumbasteln.
Gruß Walter

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige