Export data naar Excel, maar overschrijven bij eerdere entry.

Status
Niet open voor verdere reacties.
L

lvdlangenberg

Nieuwe gebruiker
Lid geworden
13 jul 2020
Berichten
3
Hallo,

Ik heb de volgende vraag:
In Excel heb ik een sheet gemaakt, waarvan de relevante data geëxporteerd wordt naar een aparte excelsheet via een macroknop.
Dat werkt prima volgens het onderstaande script, specifiek via de code Range("A2:T2").Select.

Echter is Cel A1 het klantnummer, en wanneer deze al voorkomt in het export bestand, moet deze regel overschreven worden.
In de huidige codering wordt er onderaan in het export bestand een nieuwe regel gevuld en kunnen er dus doublures gaan plaatsvinden.

Weet iemand hiervoor een aanvulling op het onderstaande script die Cel A1 in de bron ( de analyse sheet) vergelijkt met exportbestand: Export Analyse sheets (test).xlsx?

Dank voor de input!

Groet, Laurens


HTML: 
Sub ExportSheet()
'
' Export Analyse Sheet Macro
'

'
    Sheets("Export").Select
    Range("A2:T2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Open Filename:= _
        "\\Werkbestanden\Test files\Export Analyse sheets (test).xlsx"
    Range("A1").End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            True, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
    Sheets("Sheet").Select
    
    MsgBox ("Export succeeded!")
    
End Sub
 
Probeer het zo eens

Code: 
Sub VenA()
ar = Sheets("Export").Range("A2:T2")
  With GetObject("\\Werkbestanden\Test files\Export Analyse sheets (test).xlsx").Sheets(1)
    x = Application.Match(ar(1, 1), .Columns(1), 0)
    If IsNumeric(x) Then
      .Cells(x, 1).Resize(, 20) = ar
     Else
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 20) = ar
    End If
    .Parent.Close True
  End With
End Sub
 
Laatst bewerkt:
Bedankt voor je antwoord.
Helaas krijg ik een foutmelding bij dit script op de regel: .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 20) = ar

Enig idee hoe dit op te lossen?

Vriendelijk dank!

Laurens


HTML: 
Sub ExportSheet()
ar = Sheets("Export").Range("A2:T2")
  With GetObject("\\bufs02\Credit Management\Limietenbeheer\Werkbestanden\Test files\Export Analyse sheets.xlsx").Sheets(1)
    x = Application.Match(ar(1, 1), .Columns(1), 0)
    If IsNumeric(x) Then
[COLOR="#FFFF00"]      .Cells(r, 1).Resize(, 20) = ar[/COLOR]
     Else
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 20) = ar
    End If
    .Parent.Close True
  End With
End Sub
 

Bijlagen

  • Capture2.JPG
    Capture2.JPG
    43 KB · Weergaven: 33
Hallo,

wederom bedankt voor je antwoord en je hulp, het script draait nu zonder foutmeldingen.
Echter als ik het bestand wil openen waar het naartoe is geschreven, wil hij deze niet meer openen.

Ik heb allerlei varianten geprobeerd, maar het het lijkt erop dat er iets in dit bestand op een bepaalde manier wordt weg geschreven, zodat Excel het niet meer kan lezen.

Zit er iets in code dat het bereik endless maakt, of iets dergelijks?
Ik heb er te weinig verstand van om dat zelf te snappen, helaas.

Code: 
Sub ExportSheet()
ar = Sheets("Export").Range("A2:T2")
  With GetObject("\\bufs02\Credit Management\Limietenbeheer\Werkbestanden\Test files\Export Analyse sheets2.xlsx").Sheets(1)
    x = Application.Match(ar(1, 1), .Columns(1), 0)
    If IsNumeric(x) Then
      .Cells(x, 1).Resize(, 20) = ar
     Else
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 20) = ar
    End If
    .Parent.Close True
  End With
  MsgBox ("Export succeeded!")
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan