• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Gegevens kopiëren naar variabele cellen

Status
Niet open voor verdere reacties.

Amado

Gebruiker
Lid geworden
23 mrt 2001
Berichten
64
Hoi Excel-specialisten,

Ik heb volgend probleem :
ik moet maandelijks data verzenden naar een file van een extern bureau.
Deze file kan niet aangepast worden.
Mijn gegevens gaan van bijv. 1/1 tot 31/1 (zie voorbeeld file "DATA"
Voor "Januari" (eveneens in bijlage) werkt mijn macro, maar in "Februari"
veranderen de bestemmings-cellen.
Dit alles heb ik in de File "Data" beschreven.
Is hier een oplossing voor?

Alvast bedankt.

Amado
 

Bijlagen

  • Data.xlsm
    28,1 KB · Weergaven: 25
  • Januari.xlsx
    9,5 KB · Weergaven: 21
  • Februari.xlsx
    9,4 KB · Weergaven: 22
Als je echt niet kunt veranderen aan de opzet van die bestanden raak je aan zoiets.
Januari even voorgedaan hieronder. Werkt in onderstaand voorbeeld alleen als je werkboek open staat, maar die kun je zelf wel aanpassen naar workbooks.open etc.

Code:
Sub j()
With Workbooks("Januari").Sheets(1)
 Set a = .Cells.Find("Datum")
  For Each sh In ThisWorkbook.Sheets
    sh.Range("B2:D32").Copy .Cells(a.Row, 2).Offset(1)
    Set a = .Cells.FindNext(a)
  Next
 End With
End Sub
 
Thanks

Hoi JV,

Code werkt perfect, waarvoor hartelijk bedankt.

Prettige avond nog,

Amado
 
Hoi JV,

Kan die range "B2:D32" nog variabel gemaakt worden?
For Each sh In ThisWorkbook.Sheets
sh.Range("B2:D32").Copy .Cells(a.Row, 2).Offset(1)
Set a = .Cells.FindNext(a)
Zou telkens moeten gaan tot de laatste rij.
(vb. in februari "B2:D29") enz.
kan dit bijvoorbeeld met CurrentRegion - Kolom A?

Amado
 
Probeer het eens zo, heb het niet getest. In je voorbeeld zou het niet uit moeten maken om wel/niet variabel te maken.

Code:
Sub j()
With Workbooks("Januari").Sheets(1)
 Set a = .Cells.Find("Datum")
  For Each sh In ThisWorkbook.Sheets
    sh.Range("B2", sh.Cells(Rows.Count, 4).End(xlUp)).Copy .Cells(a.Row, 2).Offset(1)
    Set a = .Cells.FindNext(a)
  Next
 End With
End Sub
 
Hallo JV,

Code werkt nu perfect.
In het voorbeeld maakte het idd niet uit, maar in het origineel wel,
dus alles opgelost.
Nogmaals heel erg bedankt.

Gr,

Amado
 
Aanpassing aan oplossing t.a.v. JV

Hallo JV

In bijlage de 2 files zoals ze er uiteindelijk gaan uitzien.
De file "Januari2" is de file van het extern bureau.
De data van de bladen van mijn file "TransfertTest" moeten dus
op C42 C103 C164 C225 C286 komen (dus tussen datum en de juiste kolom zit er een lege lijn)
Ik heb in mijn bestand subtotalen gemaakt om in 1 keer te kunnen kopiëren naar hun file (om hun subtotaal lijn te ontwijken,
deze mag ook overschreven worden door mijn subtotaal of is er misschien een andere oplossing?)
De laatste kolom met weeknummer mag niet mee gekopieerd worden.
Het aantal kolommen is ook niet steeds dezelfde. (zie nieuwe files in bijlage)
Kan dit alles opgelost worden?

Gr,

Amado
 

Bijlagen

  • TransfertTest.xlsm
    47,4 KB · Weergaven: 13
  • Januari2.xls
    133,5 KB · Weergaven: 136
Reactie op JV's code

Ik heb je code nu bij de afsluiting van februari gebruikt.
Nu heb ik nog 1 probleem: de file waarnaar ik kopieer heeft een bepaalde opmaak
en deze wordt overschreven door onze macro :
HTML:
[CODE]Dim varCellvalue As String

    varCellvalue = Range("T11").Value
    ChDir "C:\Users\Gebruiker\OneDrive\Quinntra"
    
    Workbooks.Open Filename:=varCellvalue
    
   
    Windows("QuinntraTransfert.xlsm").Activate
    
     With Workbooks(varCellvalue).Sheets(1)
    Set a = .Cells.Find("Datum")
    For Each sh In ThisWorkbook.Sheets
    sh.Range("B2:K" & Range("a50").End(xlUp).Offset(0, 0).Row).Copy .Cells(a.Row, 3).Offset(2)

    Set a = .Cells.FindNext(a)
     Next
 End With[/CODE]

Kan er na die Copy een PasteSpecial komen?
 
Dan kunnen we nog plakken als waarden.

Code:
Dim varCellvalue As String
 
    varCellvalue = Range("T11").Value
    ChDir "C:\Users\Gebruiker\OneDrive\Quinntra"
    
    Workbooks.Open Filename:=varCellvalue
    
   
    Windows("QuinntraTransfert.xlsm").Activate
    
     With Workbooks(varCellvalue).Sheets(1)
    Set a = .Cells.Find("Datum")
    For Each sh In ThisWorkbook.Sheets
    sh.Range("B2:K" & Range("a50").End(xlUp).Offset(0, 0).Row).Copy 
   .Cells(a.Row, 3).Offset(2).Pastespecial xlPasteValues
 
    Set a = .Cells.FindNext(a)
     Next
 End With
 
Dan kunnen we nog plakken als waarden.

Code:
Dim varCellvalue As String
 
    varCellvalue = Range("T11").Value
    ChDir "C:\Users\Gebruiker\OneDrive\Quinntra"
    
    Workbooks.Open Filename:=varCellvalue
    
   
    Windows("QuinntraTransfert.xlsm").Activate
    
     With Workbooks(varCellvalue).Sheets(1)
    Set a = .Cells.Find("Datum")
    For Each sh In ThisWorkbook.Sheets
    sh.Range("B2:K" & Range("a50").End(xlUp).Offset(0, 0).Row).Copy 
   .Cells(a.Row, 3).Offset(2).Pastespecial xlPasteValues
 
    Set a = .Cells.FindNext(a)
     Next
 End With
 
Hoi JV,

Werkt perfect.

Bedankt en prettige avond verder
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan