Data wordt in tekst geplakt ipv er onder!!!

[CygneVoler]

Hoi Excellers,

Ik heb 2 vragen:

Vraag 1:
Met onderstaande VBA tekst probeer ik uit een importbestand tekst te plakken in een werkbestand.
Op zich werkt dit wel maar de gekopieerde tekst moet onder al aanwezige tekst worden geplakt in kolom B.
De tekst wordt echter op de een-na-onderste regel geplakt in Kolom B. Dus deze laatste regel wordt overschreven!

vraag 2:
Nadat de tekst gekopieerd en geplakt is, wil ik dat het import bestand weer wordt afgesloten.(saven is niet nodig) Hier krijg ik een foutmelding op. "fout 9, script valt buiten het bereik."


Graag vraag ik jullie kennis en kunde voor advies en hulp.

Sub Openen()

Application.ScreenUpdating = False

    On Error Resume Next
    Windows("Import.xlsx").Activate
  If Err.Number > 0 Then Workbooks.Add "C:\Users\Import.xlsx"
  On Error GoTo 0
   Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    
    Windows("Werkbestand.xlsb").Activate
    Sheets("nw_import data").Select
    Range("B" & Rows.Count, Selection.End(xlUp)).Select
    ActiveSheet.Paste
        
    Workbooks("Import.xlsx").Close SaveChanges:=False
  Application.CutCopyMode = False 

Application.ScreenUpdating = True
End Sub

Wat doe ik niet goed?

ALvast bedankt voor jullie hulp.

CooS

 

[Haije]

voor vraag 1:

Range("B" & Rows.Count, Selection.End(xlUp))[COLOR="#FF0000"].offset(1)[/COLOR].Select

voeg rode tekst toe

voor vraag 2:
wijzig

Workbooks("Import.xlsx").Close SaveChanges:=False

eens in

Windows("Import.xlsx").Close SaveChanges:=False

 

[CygneVoler]

Haije, bedankt voor je snelle reactie!
Er wordt een fout aangegeven mbt Offset(1): " 1004...door de toepassing of door object of gedefinieerde fout."

 

[VenA]

Probeer het zo eens

Sub VenA()
With GetObject("C:\Users\Import.xlsx")
  .Sheets("Blad1").Range("A2").CurrentRegion.Copy Sheets("nw_import data").Cells(Rows.Count, 2).End(xlUp).Offset(1)
  .Close 0
End With
End Sub

 

[CygneVoler]

V&A ook jij bedankt voor je snelle reactie! Het gaat bijna goed! Op een of andere manier wordt de tekst vanaf kolom A1 gekopieerd en dat is een beetje vreemd volgens mij omdat er A2 in het script staat (btw als ik A2 wijzig in A3 blijft de eerste regel mee gekopieerd)

 

[VenA]

Dan heb je nog wat onzin in rij 1 staan.:d

.Sheets("Blad1").Range("A2").CurrentRegion.offset(1)

Dit mag nu toch onderhand wel duidelijk zijn.

 

[CygneVoler]

Je klink niet erg vriendelijk maar de enige tekst die er momenteel in vermeld wordt heb ik van jou ontvangen!
Verder zal het zonder twijfel mijn onwetendheid zijn. Daarom ben ik ook blij met een site zoals deze.
Maar hartelijk dank dat je mee wilt denken.

 

[VenA]

Dus de vraag is opgelost?

 

[Ginger]

Dan heb je nog wat onzin in rij 1 staan

Het zóu gewoon de tabel header kunnen zijn die niet mee gekopieerd moet worden....

 

[Haije]

helpt dit voor vraag 1?

Range("B" & Rows.Count, Selection.End(xlUp).offset(1)).Select

 

[CygneVoler]

Mensen hartelijk dank voor jullie support. Met de oplossing van V&A werkt het idd, en Ginger en Haije ook jullie bijdrage werkt idd.
Ik heb alleen nog een andere uitdaging (durf het bijna niet meer te vragen...) maar het importbestand moet een kolom worden opgesplitst (van tekst naar kolom).
Is dat met de huidige oplossing van V&A aan te passen of dient hier een ander script voor geschreven te worden?

 

[VenA]

Ja dat is vast wel mogelijk. Dus plaats maar even een voorbeeldbestandje. En leg daarin ook uit wat het resultaat moet worden.

 

[CygneVoler]

Was al even aan het "knutselen" via een macro opname, maar dan wordt het wel geknipt en geplakt maar het splitsen doet ie niet.

Columns("H:H").Select
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True

zal idd anders wel even een test-bestand plaatsen.

 

[CygneVoler]

De uitleg heb ik in de bestanden toegevoegd. Het Import bestand is het bestand waar de tekst die "ontvangen" wordt vanuit een andere database.
De tekst vanuit het Importbestand moet deels worden gesplitst (kijk hiervoor in het bestand) en gesplitst worden geplakt in het Import_Compleet-bestand, kolom B.

Ik hoop dat het duidelijk is

 

[HSV]

Bv.

Sub hsv()
Set tw = ThisWorkbook.Sheets("nw_import")
lr = tw.Cells(Rows.Count, 2).End(xlUp).Row + 1
  With GetObject("C:\Users\Import.xlsx")
   .Sheets("blad1").Cells(1).CurrentRegion.Offset(1).Copy tw.Cells(Rows.Count, 2).End(xlUp).Offset(1)
   tw.Range(tw.Cells(lr, 9), tw.Cells(Rows.Count, 9).End(xlUp)).TextToColumns tw.Cells(lr, 9), 1, , , , , , -1
   .Close 0
  End With
End Sub

 

[CygneVoler]

iets kortere tekst Harry Hulde! Ziet er goed uit. Kan je me uitleggen waar "lr = tw" voor staat? ( ik denk tw: this workbook?)

 

[HSV]

Ja, zoals het er staat.

[COLOR=#0000ff]Set tw[/COLOR] = [COLOR=#ff0000]ThisWorkbook.Sheets("nw_import")[/COLOR]

Met lr bepaal je vooraf de laatste rij + 1 in tw.
Daarna doe je texttocolumns op lr en de data na de kopieeractie die dan ook een laatste rij heeft, dat stukje ga je splitsen.

 

[VenA]

Of eerst tekst naar kolommen en dan kopiëren

Sub VenA()
With GetObject("C:\Users\Import.xlsx")
  With .Sheets("Blad1")
    .Columns(8).TextToColumns .Cells(1, 8), 1, , , , , , -1
    .Cells(1).CurrentRegion.Offset(1).Copy ThisWorkbook.Sheets("NW_import").Cells(Rows.Count, 2).End(xlUp).Offset(1)
  End With
  .Close 0
End With
End Sub

 

[HSV]

Als importbestand een weggooi bestand is kan het, anders ga je het mooi verknallen. :d

 

[CygneVoler]

Duidelijk, er zijn vele wegen die naar Rome leiden. Harry, bedankt voor je uitleg.
Iedereen die zijn of haar bijdrage heeft geleverd, hartelijk dank.