Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Kopiere ohne Formatierung

Betrifft: Kopiere ohne Formatierung von: Zimmer
Geschrieben am: 22.09.2020 13:58:49

Hallo, bräuchte mal bitte Hilfe!

Sub ?bernahme()
'On Error Resume Next

If Tabelle1.Range("C1").Value = "" Then
MsgBox ("Kommission fehlt du d?del:-)")
Exit Sub
End If


Dim Kommission As String
Dim Erstellt As String
Dim Artikelnummer As String
Dim Artikelname As String
Dim St?ckzahl As String
Dim wb As Workbooks
Dim blnOffen As Boolean
Dim Vers1 As String
Dim Vers2 As String
Dim Vers3 As String
Dim Vers4 As String
Dim Vers5 As String
Dim Vers6 As String
Dim Vers7 As String
Dim Vers8 As String
Dim Vers9 As String
Dim Vers10 As String
Dim Vers11 As String
Dim Vers12 As String




Worksheets("Tabelle1").Select
Kommission = Range("C1")
Erstellt = Range("B1")
Artikelnummer = Range("I4")
Artikelname = Range("J4")
Stückzahl = Range("D1")
Vers1 = Range("H4")
Vers2 = Range("H5")
Vers3 = Range("H6")
Vers4 = Range("H7")
Vers5 = Range("H8")
Vers6 = Range("H9")
Vers7 = Range("H10")
Vers8 = Range("H11")
Vers9 = Range("H12")
Vers10 = Range("H13")
Vers11 = Range("H14")
Vers12 = Range("H15")


Workbooks.Open FileName:="\\Prduktionsplanung\Aufträge\Auftrag makros\ _
Zusammenfassung_Rahmenrohr.xlsm"
Workbooks("Zusammenfassung_Rahmenrohr.xlsm").Worksheets("Gesamt").Activate
Worksheets("Gesamt").Range("A10").Select
If Worksheets("Gesamt").Range("A10").Offset(1, 0) <> "" Then
Worksheets("Gesamt").Range("A10").End(xlDown).Select
End If

ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Erstellt
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Kommission
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Artikelnummer
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Artikelname
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = St?ckzahl
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers2
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers3
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers4
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers5
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers6
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers7
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers8
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers9
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers10
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers11
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Vers12
    
 
    
   

   MsgBox "in Zusammenfassung übernommen!"
    Application.CutCopyMode = False




End Sub

Das ist der Code um den es sich dreht, allerdings wird beim Kopieren wahrscheinlich die Zellenformatierung mit kopiert, in dem anderen Tabellenblatt will ich mit der =SVERWEIS(MIN($F$11:$F$13);$F$11:$F$13;1;FALSCH)
Funktion nach dem aktuellsten Versanddatum filtern, dies funktioniert leider jetzt nicht mehr, könnte mir bitte jemand dabei helfen???

Betrifft: AW: Kopiere ohne Formatierung
von: Claus Ohlendorf
Geschrieben am: 22.09.2020 14:05:36

Eventuell hilft es, nur die Werte zu übernehmen:

Also z.B.
Vers12 = Range("H15").value

Gruss
Claus

Betrifft: falscher Datentyp
von: Rudi Maintaire
Geschrieben am: 22.09.2020 15:45:47

Hallo,
Dim Erstellt as Date

Gruß
Rudi

Betrifft: AW: falscher Datentyp
von: Zimmer
Geschrieben am: 23.09.2020 06:37:06

@Rudi Maintaire

Perfekt! Super Simpel!
Vielen Dank

Gruß Daniel

Betrifft: AW: Kopiere ohne Formatierung
von: Herbert_Grom
Geschrieben am: 22.09.2020 15:47:44

Hallo,

da dein Code etwas lang ist, habe ich ihn dir mal etwas "gekürzt". Schau mal ob dir das hilft:
Option Explicit
Option Base 1


Sub Übernahme()
   Dim arrA, iCount%, sRange$, iLastRow%
   
   If Tabelle1.Range("C1").Value = "" Then
      MsgBox "Kommission fehlt du Dödel:-)", vbCritical, "!"
      Exit Sub
   End If
   
   arrA = Array("C1", "B1", "I4", "J4", "D1", "H4", "H5", "H6", "H7", "H8", "H9", "H10", "H11",  _
"H12", "H13", "H14", "H15")
   
   Workbooks.Open Filename:="\\Produktionsplanung\Aufträge\Auftrag makros\ _
Zusammenfassung_Rahmenrohr.xlsm"
   Workbooks("Zusammenfassung_Rahmenrohr.xlsm").Worksheets("Gesamt").Activate
   Worksheets("Gesamt").Range("A10").Select
      
   With Worksheets("Gesamt")
      If .Range("A10").Offset(1, 0) <> "" Then
         .Range("A10").End(xlDown).Select
      End If
      
      iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
       
      For iCount = 1 To UBound(arrA)
         sRange = arrA(iCount)
         Range("A" & iCount + iLastRow).Value = Tabelle1.Range(sRange).Value
      Next iCount
   End With
   
   MsgBox "in Zusammenfassung übernommen!", vbInformation, "!"
End Sub
Servus

Betrifft: @Herbert
von: Rudi Maintaire
Geschrieben am: 22.09.2020 15:51:13

Hallo,
was soll das denn?
arrA = Array("C1", "B1", "I4", "J4", "D1", "H4", "H5", "H6", "H7", "H8", "H9", "H10", "H11", _
"H12", "H13", "H14", "H15")
Da hast du die Texte C1, B1 etc. im Array.

Gruß
Rudi

Betrifft: AW: @Herbert
von: Herbert_Grom
Geschrieben am: 22.09.2020 16:15:24

Hallo Rudi,

jetzt habe ich doch ausgerechnet von dir die Array-Verarbeitung gelernt, anno 2006 in Ziegenrück, und jetzt tadelst du mich deshalb! Ich habe doch nicht die "Texte" ins Array übernommen, sondern nur die Adressen! Oder habe ich was übersehen!

Servus

Betrifft: @Herbert: Sorry
von: Rudi Maintaire
Geschrieben am: 22.09.2020 19:27:20

Hallo,
ich war so schockiert von der Zeile, dass ich deinen Code gar nicht weiter gelesen habe :-(

Gruß
Rudi

Betrifft: AW: @Herbert: Sorry
von: Daniel
Geschrieben am: 22.09.2020 20:19:16

wobei sich die Frage stellt, warum man die Zellen H4:H15 nicht per Copy-Paste als Block in einem Schritt überträgt.
Das wäre der Performance wesentlich zuträglicher als alle Werte einzeln einzutragen.
Gruß Daniel

Betrifft: AW: @Herbert: Sorry
von: Herbert_Grom
Geschrieben am: 22.09.2020 20:41:19

Hallo Daniel,

und da hast du auch wieder recht! Manchmal sieht man den Wald vor lauter Bäumen nicht mehr! ;o)=)

Servus

Betrifft: AW: @Herbert: Sorry
von: Herbert_Grom
Geschrieben am: 22.09.2020 20:38:41

Hallo Rudi,

puh, jetzt bin ich aber erleichtert, dass ich das nicht verkackt habe!

Servus

Betrifft: AW: Kopiere ohne Formatierung
von: Herbert_Grom
Geschrieben am: 23.09.2020 15:11:05

Hallo Zimmer,

hast du meinen Code denn mal getestet?

Servus

Beiträge aus dem Excel-Forum zum Thema "Kopiere ohne Formatierung"