and [\CODE]. Is that the right way to forum code ?
Sorry. I supposed the code was not necessary as the only difference between working and not working is the maximum number of rows and columns in the source file.
Many thanks
Frank
[CODE]
Option Explicit
Option Base 1
Option Compare Text
Public titels()
Public mijnBronBestand As String
Public mijnBronSheet As String
Public mijnDoelbestand As String
Public mijnRef As String
Public gebied
Public mijnBronStartkolom As Long
Public mijnBronEindkolom As Long
Public mijnBronEindRij As Long
Public mijnDoelStartkolom As Long
Public mijnDoelEindKolom As Long
Public mijnDoelEindrij As Long
Public mijnDoelStartrij As Long
Public mijnDoelEindrijHULP As Long
Public g As String
Public h As String
Public mijnDoelBook As String
Public mijnDoelsheet As String
Public Myfile As String
Public Stopped As Boolean
Public Firstref As Range
Public Firstresult As Range
Public Bronartikelkolom As Range
Public Doelsheet As Worksheet
Public Doelbook As Workbook
Public Bronbook As Workbook
Public Bronsheet As Worksheet
Sub Modulekolom1()
Set Doelbook = ActiveWorkbook
Set Doelsheet = ActiveSheet
Call Resultplaats
Cells(1, 1).Select
frmBronkeuze1.Show
Debug.Print ActiveWorkbook.Name
Set Bronbook = ActiveWorkbook
Debug.Print ActiveWorkbook.Name
Call Choose_data
End Sub
Sub Resultplaats()
Set Firstref = Application.Selection
Set Firstref = Application.InputBox("Klik op het veld waar eerste artikelnummer/barcode staat:", , Firstref.Address, Type:=8)
Set Firstresult = Application.Selection
Set Firstresult = Application.InputBox("Klik op het veld waar het eerste resultaat moet komen en zorg " & Chr(13) & "dat de cel erboven leeg is voor het plaatsen van de titels:", , Firstresult.Address, Type:=8)
Dim artbar As Long
artbar = Len(Firstref.Value)
If artbar = 9 Then
h = 1
Else
h = 19
End If
mijnDoelStartkolom = Firstresult.Column
mijnDoelEindrijHULP = Firstref.Column
mijnDoelEindrij = Cells(Rows.Count, mijnDoelEindrijHULP).End(xlUp).Row
mijnDoelStartrij = Firstref.Row
Firstref.Select
End Sub
Option Explicit
Option Base 1
Option Compare Text
Sub Choose_data()
Dim mijnCel As Range
Dim Teller As Byte
Dim mijnZoeken
Dim mijnBereik
Bronbook.Activate
Cells(10, 10).Select
On Error GoTo 0
Cells(1, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Teller = 1
For Each mijnCel In Selection
ReDim Preserve titels(1 To Teller)
titels(Teller) = mijnCel.Value
Teller = Teller + 1
Next
frmKiesTitels.Show
mijnBronStartkolom = 1
mijnBronEindkolom = 255
Cells(1, mijnBronStartkolom).Select
Workbooks(mijnDoelbestand).Activate
Cells(mijnDoelStartrij, mijnDoelStartkolom).Select
Debug.Print Bronbook.Name
g = Bronbook.Name
Debug.Print Bronbook.Name
ActiveCell.FormulaR1C1 = _
"=INDEX('[" & g & "]Sheet1'!R1:R65536,MATCH(RC" & mijnDoelEindrijHULP & ",'[" & g & "]Sheet1'!C" & h & ",0),MATCH(R" & mijnDoelStartrij - 1 & "C,'[" & g & "]Sheet1'!R1C1:R1C255,0))"
Cells(mijnDoelStartrij, mijnDoelStartkolom).Select
If mijnDoelStartkolom <> mijnDoelEindKolom Then
mijnBereik = Range(Cells(mijnDoelStartrij, mijnDoelStartkolom), Cells(mijnDoelStartrij, mijnDoelEindKolom)).Address
Selection.AutoFill Destination:=Range(mijnBereik)
Else
End If
Range(Cells(mijnDoelStartrij, mijnDoelStartkolom), Cells(mijnDoelStartrij, mijnDoelEindKolom)).Select
mijnBereik = Range(Cells(mijnDoelStartrij, mijnDoelStartkolom), Cells(mijnDoelEindrij, mijnDoelEindKolom)).Address
Selection.AutoFill Destination:=Range(mijnBereik)
mijnBereik = Range(Cells(mijnDoelStartrij, mijnDoelStartkolom), Cells(mijnDoelEindrij, mijnDoelEindKolom)).Address
Range(mijnBereik).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells(1, 1).Select
Application.ScreenUpdating = True
If Bronbook.Name = "VKB115 - aktieve artikelen Wommelgem.xls" Then
Bronbook.Close SaveChanges:=False
Else
End If
MsgBox "Gevraagde gegevens zijn overgebracht"
Exit Sub
bestandsfout:
MsgBox "Bronbestand is niet gevonden! Macro stopt", , "Verkeerde bron"
End
zoekfout:
MsgBox mijnZoeken & " is niet gevonden. De macro stopt", , "Niet gevonden"
End
End Sub
Option Explicit
Private Sub CommandButton1_Click()
If OptionButton1.Value = True Then
Workbooks.Open FileName:= _
"G:\Wommelgem\Algemeen\EXCEL TOEPASSINGEN\VKB115 - aktieve artikelen Wommelgem.XLS"
Unload Me
Else
If OptionButton2.Value = True Then
Unload Me
frmSelectOpenBooks.Show
Else
Unload Me
End If
End If
Sheets(1).Name = "Sheet1"
Dim kolnrlast As Long
Cells(1, Columns.Count).Select
kolnrlast = Selection.End(xlToLeft).Column
Dim qt As Long
For qt = 1 To kolnrlast
If IsEmpty(Cells(1, qt).Value) = True Then
Cells(1, qt).Value = "no header"
End If
Next qt
End Sub
Private Sub UserForm_Initialize()
OptionButton1.Value = True
End Sub
Option Explicit
' stop als op cancel wordt geklikt
Private Sub cmdCancel_Click()
Unload Me
End
End Sub
' Bij OK moeten alle titels ingevuld worden (achter de laatst gevulde kolom) vanaf de doelstartkolom
Private Sub cmdOK_Click()
Dim strSelecties()
Dim artikels()
Dim i As Long
Dim p As Long
Dim bytVolgorde As Byte
Dim gebied
Dim Teller As Long
Doelbook.Activate
mijnDoelbestand = ActiveWorkbook.Name 'zonder pad
i = 0 'initialisatie van aantal geselecteerde elementen
For bytVolgorde = 0 To Me.lstTitles.ListCount - 1
If lstTitles.Selected(bytVolgorde) Then
i = i + 1
ReDim Preserve strSelecties(1 To i)
strSelecties(i) = lstTitles.List(bytVolgorde)
End If
Next bytVolgorde
Cells(mijnDoelStartrij - 1, mijnDoelStartkolom).Select
p = i
For i = LBound(strSelecties) To UBound(strSelecties)
ActiveCell.Offset(0, i - 1).Value = strSelecties(i)
Next
mijnDoelEindKolom = mijnDoelStartkolom + p - 1
Unload Me
Exit Sub
bestandsfout:
MsgBox "Het doelbestand is niet gevonden. Is het correct ingevuld?", , "Doelbestand niet gevonden"
End Sub
' initilaisatie van de userform: invullen van de titels in de listbox
' listbox lstTitels heeft een eigenschap multiselect zodat meerdere titels kunnen geselecteerd worden
Private Sub UserForm_Initialize()
Dim i As Byte
For i = LBound(titels) To UBound(titels)
Me.lstTitles.AddItem titels(i)
Next
End Sub
Option Explicit
Private Sub ComboBox1_Change()
End Sub
Private Sub CommandButton1_Click()
Myfile = Me.ListBox1.Value
Windows(Myfile).Activate
Range("A1:A1").Select
Set Bronartikelkolom = Application.Selection
Set Bronartikelkolom = Application.InputBox("Klik in kolom waar art. Koopman staat:", , Bronartikelkolom.Address, Type:=8)
h = Bronartikelkolom.Column
Debug.Print ActiveWorkbook.Name
Set Bronbook = ActiveWorkbook
Debug.Print ActiveWorkbook.Name
Debug.Print Bronbook.Name
Unload Me
End Sub
Private Sub CommandButton2_Click()
Stopped = True
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim wkb As Workbook
With Me.ListBox1
For Each wkb In Application.Workbooks
.AddItem wkb.Name
Next wkb
End With
End Sub
