• 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.

kopiëren/plakken

Status
Niet open voor verdere reacties.

patje8

Gebruiker
Lid geworden
31 jul 2005
Berichten
436
Is het mogelijk om via een macro bepaalde cellen te kopiëren en te plakken in een andere sheet, ook al heeft de sheet waarvan je moet kopiëren steeds een andere naam?
 
Onderstaande macro kopieert de cellen A1 t/m A7 van het 1e werkblad naar werkblad (Blad2).


Sub Macro1()
Worksheets(1).Range("A1:A7").Select
Selection.Copy
Worksheets("Blad2").Select
Range("A1").Activate
ActiveSheet.Paste
End Sub
 
Dit is enkel kopiëren van blad naar blad in dezelfde file kan dit ook van de ene file naar de andere?
 
Onderstaande macro kijkt eerst wat de actieve werkboek is.
Vervolgens wordt gecontroleerd hoeveel Excelbestanden er open staan.
Is dat er
1 - Melding dat er maar 1 bestand open staat.
2 - Er wordt gezocht naar het andere bestand.
>2 (meer dan 2). Er verschijnt een melding dat er meer dan 2 bestanden zijn. Bij die melding verschijnt ook een lijst van die bestanden.

Zijn er 2 bestanden of maak je een keuze bij 2 of meer, dan wordt van het 1e werkblad van het gevonden bestanden de cellen a1 t/m a7 gekopieerd naar het 1e werkblad van het oorspronkelijke bestand.

Public Sub Macro1()
Dim ActWb As String
Dim IP As String
ActWb = ActiveWorkbook.Name
Select Case Workbooks.Count
Case 1
MsgBox "Er is geen ander werkblad open", vbInformation, "Geen ander werkblad open"
Exit Sub
Case 2
For teller = 1 To Workbooks.Count
If Workbooks(teller).Name <> ActWb Then
IP = Workbooks(teller).Name
End If
Next
Case Is > 2
For teller = 1 To Workbooks.Count
If Workbooks(teller).Name <> ActWb Then
naam = naam & Workbooks(teller).Name & Chr(10)
End If
Next
IP = InputBox("Er zijn meerdere bestanden gevonden." & Chr(10) & _
" Welk bestand wilt u gebruiken ?" & Chr(10) & Chr(10) & naam)
End Select
If IP <> "" Then
For teller = 1 To Workbooks.Count
If Workbooks(teller).Name = IP Then
Workbooks(IP).Activate
Worksheets(1).Range("A1:A7").Select
Selection.Copy
Workbooks(ActWb).Activate
Worksheets1).Select
Range("A1").Activate
ActiveSheet.Paste
End If
Next
End If
End Sub
 
Dit lukt prima, bedankt.

Is het ook mogelijk dat hij de lege lijnen niet kopiëert?
 
Er wordt alleen gekopieerd als de broncel niet leeg is.

Public Sub Macro1()
Dim ActWb As String
Dim IP As String
ActWb = ActiveWorkbook.Name
Select Case Workbooks.Count
Case 1
MsgBox "Er is geen ander werkblad open", vbInformation, "Geen ander werkblad open"
Exit Sub
Case 2
For teller = 1 To Workbooks.Count
If Workbooks(teller).Name <> ActWb Then
IP = Workbooks(teller).Name
End If
Next
Case Is > 2
For teller = 1 To Workbooks.Count
If Workbooks(teller).Name <> ActWb Then
naam = naam & Workbooks(teller).Name & Chr(10)
End If
Next
IP = InputBox("Er zijn meerdere bestanden gevonden." & Chr(10) & _
" Welk bestand wilt u gebruiken ?" & Chr(10) & Chr(10) & naam)
End Select
If IP <> "" Then
For teller = 1 To Workbooks.Count
If Workbooks(teller).Name = IP Then
Workbooks(IP).Activate
For rij = 1 To 7
If Worksheets(1).Cells(rij, "A") <> "" Then
Worksheets(1).Cells(rij, "A").Select
Selection.Copy
Workbooks(ActWb).Activate
Worksheets(1).Cells(rij, "A").Select
ActiveSheet.Paste
End If
Next
End If
Next
End If
End Sub
 
Sorry :( , maar dat lukt niet.

Het is de bedoeling dat de gegevens van "test2" in kolom A en C in "test1" komen te staan in kolom A en B. Wanneer er een "test3" zoals "test2" wordt aangemaakt moeten deze gegevens ook gekopiëerd worden naar "test1" maar onder de rest.
 

Bijlagen

In de zip-file zitten 3 bestanden.

De macro zit in test1. Verder is er test2 en test4.

De macro telt het aantal bestanden.
Vervolgens zet de macro de gegevens van kolom A en C van de gevonden bestanden (in dit geval test2 en test4) onder elkaar in de kolommen A en B van test1.

Dit ziet er dan als volgt uit:

test1 rest1
test2 rest2
test3 rest3
test4 rest4
test6 rest5
test7 rest6
test9 rest7
test10 rest8
test11 rest9
test12 rest11
test13 rest12
test14 rest13
test15 rest15
test16 rest16
test18 rest17
test19 rest18
test20 rest19
test21 rest20
test1 rest21
test2 Nieuw1
test3 Nieuw2
test4 Nieuw3
test6 Nieuw4
test7 Nieuw5
test9 Nieuw6
test10 Nieuw7
test11 Nieuw8
test12 Nieuw9
test13 Nieuw10
test14 Nieuw11
test15 Nieuw12
test16 Nieuw13
test18 Nieuw14
test19 Nieuw15
test20 Nieuw16
test21 Nieuw17
Nieuw18
Nieuw19
Nieuw20
Nieuw21
 
Laatst bewerkt:
Het is wel de bedoeling dat als er een cel ik kolom A leeg is er niet moet overgenomen worden.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan