kolommen in andere bestanden opvragen en plakken

[joost66]

Ik heb in 5 afzonderlijke bestanden telkens in kolom K data staan. Deze data wil ik totaliseren in een verzamelbestand. Vanuit dit verzamelbestand wil ik boven 5 kolommen (D, E, F, G, H) een knop plaatsen. Na het klikken op die knop moet het volgende gebeuren:
- venster openen om het betreffende bestand te selecteren
- kolom K van dat bestand moet in het reeds openstaande verzamelbestand in kolom D worden gekopieerd (waarden).

Boven de andere kolommen (E t/m H) staat ook een knop en daar moet dan hetzelfde gebeuren. Ik zou graag een VBA code willen die dit mogelijk maakt. De knop staat telkens bovenaan de kolom waarin de gegevens moeten worden gekopieerd. Daar kan wellicht dan 1 kode (met actuele kolom) voor worden gebruikt,ipv 5 aparte kodes per knop. Maar dat maakt mij zelf niet zoveel uit.

Ik zie graag reactie tegemoet. en bedankt alvast.

 

[gast0660]

Hoi,
Ik ga er vandaag zeker niet meer op ingaan, maar een voorbeeldje zegt meer dan woorden.

Greetz

 

[joost66]

ik heb via opnemen macro nu het volgende:
Via een knop in een geopend bestand waarin ik de gegevens wil opnemen start ik de volgende macro

Sub kolomkopierenanderbestand()
'
' kolomkopierenanderbestand Macro

    Dim MyFile As String
    MyFile = Application.GetOpenFilename()
    Workbooks.Open Filename:=MyFile
    ActiveWindow.DisplayHeadings = True
    Columns("K:K").Select
    Selection.Copy
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Application.DisplayAlerts = True
    Range("J1").Select
    ActiveSheet.Paste

Bij de regel ActiveSheet.Paste krijg ik foutmelding 1004 Methode Paste van klasse worksheet is mislukt.
Wat is er fout?

 

[joost66]

wie heeft er antwoord op mijn laatste bericht over de foutmelding?

 

[VenA]

Ik krijg geen foutmelding behalve dat er een End Sub ontbreekt. Het plaatsen van een voorbeeldje zoals in #2 gevraagd is, is blijkbaar teveel moeite. Ook klopt de code niet met de OP of is mij de bedoeling niet duidelijk.

 

[HSV]

Sub kolomkopierenanderbestand()
'
' kolomkopierenanderbestand Macro
Dim MyFile As Variant
   MyFile = Application.GetOpenFilename()
    If MyFile <> False Then
    Workbooks.Open MyFile
      ActiveWorkbook.Sheets(1).Columns(11).Copy ThisWorkbook.Sheets(1).Range("j1")
      ActiveWorkbook.Close
   End If
End Sub

 

[joost66]

Harry, bedankt dit werkt bijna goed.
Er wordt nu formules gekopieerd en ik wil alleen de waarden overnemen. Wat moet ik daarvoor aanpassen?

 

[HSV]

Hallo Joost,

Ik heb vier varianten neergezet waarvan je er drie mag verwijderen.
Ik heb het in methode 3 en 4 niet op gehele kolom, maar op het bereik van kolom K gedaan (dit werkt sneller).

Probeer ze maar eens alle vier uit.

Sub kolomkopierenanderbestand()
'
' kolomkopierenanderbestand Macro
Dim MyFile As Variant, rng As Range
   MyFile = Application.GetOpenFilename()
    If MyFile <> False Then
    Workbooks.Open MyFile
'***** methode 1
   '  ThisWorkbook.Sheets(1).Columns(10) = ActiveWorkbook.Sheets(1).Columns(11).Value

'***** methode 2
   ' ActiveWorkbook.Sheets(1).Columns(11).Copy
   ' ThisWorkbook.Sheets(1).Cells(1, 10).PasteSpecial -4163
     
'***** methode 3
  '  ActiveWorkbook.Sheets(1).Range("K1:K" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Copy
  '    ThisWorkbook.Sheets(1).Cells(1, 10).PasteSpecial xlPasteValues

'***** methode 4
      Set rng = ActiveWorkbook.Sheets(1).Range("K1:K" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
      ThisWorkbook.Sheets(1).Range(rng.Address).Offset(, -1) = rng.Value
      
      
      ActiveWorkbook.Close
   End If
End Sub

 

[joost66]

Harry, bedankt. Het werkt goed. Ik ga er nog even verder mee. Als ik daar niet uit kom, roep ik graag je hulp nog even in.

 

[joost66]

Harry, ik heb methode 3 gebruikt. Ik heb 2 vragen:
1. Bij uitvoeren krijg ik de melding 'Er is een grote hoeveelheid informatie aanwezig op het klembord. Wilt u deze informatie in een ander document kunnen plakken'. Dat wil ik inderdaad. Maar deze melding wil ik voorkomen.
2. Ik heb de volgende code aan het begin toegevoegd, omdat ik wil dat de bestandlijst die wordt getoond de actuele map moet zijn van het al geopende bestand. Maar helaas werkt het niet. Ik werk op een citrix netwerk. Wellicht werkt daar de volgende kode toch niet goed of heb ik een andere code nodig.

Dim StartingDir As String
StartingDir = CurDir
ChDir StartingDir

 

[HSV]

Ik zou methode 4 kiezen.

 

[VenA]

Probeer dit even in de Citrix omgeving. Geeft bij mij de juiste waarden in Citrix.

MsgBox "CurDir: " & CurDir & Chr(13) & "ThisWorkbook.Path: " & ThisWorkbook.Path

 

[joost66]

VenA, mijn kode ziet er nu als volgt uit. De code die jij aangaf weet ik niet goed hoe ik die nu moet aanpassen? Kun je dat aangeven?

Sub kolomkopierenanderbestand1()
Dim StartingDir As String
StartingDir = CurDir
ChDir StartingDir
Dim MyFile As Variant, rng As Range
MyFile = Application.GetOpenFilename()
    If MyFile <> False Then
        Workbooks.Open MyFile
        ActiveWorkbook.Sheets(1).Range("K1:K" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Copy
        ThisWorkbook.Sheets(1).Cells(1, 12).PasteSpecial xlPasteValues
        ActiveWorkbook.Close
        Range("A1").Select
    End If
End Sub

 

[joost66]

Harry, ik heb methode 4 geprobeerd, maar daarbij wordt niets gekopieerd. Moet ik nog wat in de code aanpassen?
Heb je verder ook nog antwoorden op mijn 2 vragen van gisteravond?

 

[HSV]

Zit er wel gegevens in kolom K van het bestand wat je gaat openen?

Sub hsv()
Dim objBestand As String, rng As Range
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Citrix...."
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excelbestanden", "*.xls; *.xlsm; *.xlsx", 1
    .InitialFileName = ThisWorkbook.Path
    If .Show = -1 Then
        objBestand = .SelectedItems(1)
        Workbooks.Open objBestand
        With Sheets(1)
          Set rng = ActiveWorkbook.Sheets(1).Range("K1:K" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
             ThisWorkbook.Sheets(1).Range(rng.Address).Offset(, -1) = rng.Value
             ActiveWorkbook.Close
        End With
    End If
End With
End Sub

 

[joost66]

Harry, bedankt voor snelle oplossing. De standaardmap gaat goed.
Er wordt helaas nog niets gekopieerd. Er staan in kolom K wel gegevens, want als ik methode 3 gebruik lukt het wel en worden er gegevens uit andere bestand gehaald.

Kun je de code nog eens goed bekijken?
Als ik code van eerste regel optie 3 en 4 vergelijk lijkt dit hetzelfde, dus gegevens zouden uit kolom K gehaald moeten worden.
De 2e regel van optie 4: ThisWorkbook.Sheets(1).Range(rng.Address).Offset(, -1) = rng.Value kan ik niet zo goed volgen.

Hoor graag nog van je.

 

[HSV]

De gegevens van kolom K van het te openen bestand worden hier netjes in kolom J geschreven.
Daarom vroeg ik of er wel gegevens in stonden.

 

[joost66]

Harry, je hebt gelijk. Kolom K was verborgen. Dat was dus het probleem.
Bedankt voor je hulp!!

 

[HSV]

Graag gedaan Joost.

 

[joost66]

Harry, ik heb nog een wens. Na deze kopieeractie wil ik vanuit het andere bestand ook de cellen J5 t/m j8 kopieeren naar L5 t/m 8 in het basisbestand. Dus met deze actie overschrijf ik na de eerste kopieeractie van een hele kolom enkele cellen daarvan. (kopieeractie was kolom K uit andere bestand naar kolom L in basisbestand). Kun je daarvan ook de code toevoegen?