Thema Datum  Von Nutzer Rating
Antwort
18.08.2017 13:29:57 Maxim
NotSolved
18.08.2017 13:32:08 Gast72958
NotSolved
Rot Übertragen von neuen Preisen
18.08.2017 15:33:00 Kai
NotSolved
21.08.2017 08:39:51 Maxim
NotSolved
21.08.2017 14:26:36 Kai
NotSolved

Ansicht des Beitrags:
Von:
Kai
Datum:
18.08.2017 15:33:00
Views:
612
Rating: Antwort:
  Ja
Thema:
Übertragen von neuen Preisen

Hallo Maxim,

in meinem Beispiel ist das Makro in der Datei "Preise_neu.xlsm", welche die neuen Preise enthält

Die alten Preise habe ich in der Datei "Preise_alt.xlsx" gespeichert. Die Daten stehen jeweils "Tabelle1" die Daten sind  wie folgt aufgebaut:

Spalte A Produktname

Spalte B Preis Alt

Spalte C Preis Neu

 

Option Explicit

Sub kopierePreise()

Dim wbPreiseNeu, wbPreiseAlt As Workbook
Dim lngLetzteZeileProdukteAlt, lngLetzteZeileProdukteNeu As Long
Dim strPreiseAlt As String
Dim curPreisAlt As Currency
Dim rngPreiseAlt As Range
Dim i As Integer

strPreiseAlt = "Preise_alt.xlsx"
Set wbPreiseNeu = ThisWorkbook
Application.Workbooks.Open strPreiseAlt
Set wbPreiseAlt = Workbooks(strPreiseAlt)


lngLetzteZeileProdukteNeu = wbPreiseNeu.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row

With wbPreiseAlt.Sheets("Tabelle1")
    lngLetzteZeileProdukteAlt = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rngPreiseAlt = .Range(.Cells(1, 1), .Cells(lngLetzteZeileProdukteAlt, 3))
End With

For i = 2 To lngLetzteZeileProdukteNeu
    With wbPreiseNeu.Sheets("Tabelle1")
        On Error Resume Next
        curPreisAlt = Application.VLookup(.Cells(i, 1).Value, rngPreiseAlt, 3, False)
        If curPreisAlt = 0 Then
            .Cells(i, 2).Value = ""
        Else
            .Cells(i, 2).Value = curPreisAlt
        End If
            curPreisAlt = 0
    End With
Next i


End Sub

 

Viele Grüße

 

Kai


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
18.08.2017 13:29:57 Maxim
NotSolved
18.08.2017 13:32:08 Gast72958
NotSolved
Rot Übertragen von neuen Preisen
18.08.2017 15:33:00 Kai
NotSolved
21.08.2017 08:39:51 Maxim
NotSolved
21.08.2017 14:26:36 Kai
NotSolved