Thema Datum  Von Nutzer Rating
Antwort
03.05.2021 11:32:04 Susanne
NotSolved
03.05.2021 12:00:48 Gast90909
NotSolved
03.05.2021 12:33:25 volti
NotSolved
Blau nur Werte übertragen
03.05.2021 13:15:48 Susanne
NotSolved
03.05.2021 13:31:17 volti
NotSolved
03.05.2021 14:04:43 Susanne
NotSolved
03.05.2021 14:47:50 volti
NotSolved
03.05.2021 15:07:53 Susanne
Solved
03.05.2021 15:09:55 Susanne
NotSolved

Ansicht des Beitrags:
Von:
Susanne
Datum:
03.05.2021 13:15:48
Views:
567
Rating: Antwort:
  Ja
Thema:
nur Werte übertragen

Vielen Dank Karl-Heinz

 

Leider wird mir bei

With Sheets ("Tabelle1") eine Fehlermeldung angezeigt.

Eventuell hilft das ganze Skript, den Fehler zu beheben.

Option Explicit


Sub uebertrag()
Application.ScreenUpdating = False


Const Tabelle1 = "Datenbank "           ' Source
Const Tabelle3 = "Ziel" ' Ziel
Dim i As Integer
Dim iAnz As Integer
Dim letzte As Long

       Worksheets("Ziel").Activate
  
    letzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
      
    ' Markiert und löscht den Bereich
    Worksheets("Ziel").Range("A1:AA" & letzte).Clear

    ' Kopiert die Überschrift
    Worksheets("Datenbank ").Range("A18:AM18").Copy
    Worksheets("Ziel").Activate
    Range("A3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Worksheets("Ziel").Range("A4").Activate
  
 Sheets(Tabelle1).Activate
 Range("A4").Select
 iAnz = 0
 i = 0

 Do Until i = ActiveSheet.UsedRange.Rows.Count
  If ActiveCell.Value = "x" Then
     Selection.EntireRow.Copy
     Sheets(Tabelle3).Activate
     ActiveSheet.Paste
    
     ActiveCell.Offset(1, 0).Select
     Sheets(Tabelle1).Select
     ActiveCell.Offset(1, 0).Select
     iAnz = iAnz + 1
     Else
     ActiveCell.Offset(1, 0).Select
   End If
   i = i + 1
 Loop

  MsgBox "Es wurde " & iAnz & " Satz übertragen"
 
 Application.CutCopyMode = False
 Application.ScreenUpdating = True

End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
03.05.2021 11:32:04 Susanne
NotSolved
03.05.2021 12:00:48 Gast90909
NotSolved
03.05.2021 12:33:25 volti
NotSolved
Blau nur Werte übertragen
03.05.2021 13:15:48 Susanne
NotSolved
03.05.2021 13:31:17 volti
NotSolved
03.05.2021 14:04:43 Susanne
NotSolved
03.05.2021 14:47:50 volti
NotSolved
03.05.2021 15:07:53 Susanne
Solved
03.05.2021 15:09:55 Susanne
NotSolved