PDA

View Full Version : Error 438 in VBA - help :)



Decision
11-26-2014, 06:39 AM
Hallo,

Kan iemand mij helpen met het volgende: ik heb een code geschreven om excel files te laden in een bepaald model. Ik krijg echter een error melding (438: object doesnt support this property..' en kom er zelf niet uit. Het gaat om de volgende code hieronder weergegeven. Het stuk in bold ​is waar de error zit volgens excel.. Kan iemand mij uit de brand helpen? Thanks!

Sub Import_Quoations()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "D:\VU\Decision Making\Final Model\"
fileName = Dir(directory & "Carrier*?")

Do While fileName <> ""

Workbooks.Open (directory & fileName)

For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("Canon_Final_Model0.1").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("Canon_Final_Model0.1")(total)
Next sheet

Workbooks(fileName).Close

fileName = Dir()

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Charlize
11-27-2014, 05:43 AM
Ik dacht aan het volgende. Ik ga ervan uit dat de verzamel excel werkboek het bestand is dat de code bevat. Loop door de code met F8 zodat je kan zien waar het misschien fout gaat (kan niet testen).

Sub Import_Quoations()'filename, sheet, total zijn mogelijks keywords
'Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim mydir As String, myfile As String, mysheet As Worksheet, mytotal As Long, mywb As Workbook
'bestemmingsworkbook om naartoe te copiëren
Dim totalwb As Workbook, nosheets As Long


Application.ScreenUpdating = False
Application.DisplayAlerts = False


'directory
mydir = "D:\VU\Decision Making\Final Model\"
'bestanden
myfile = Dir(directory & "Carrier*?")
'zet workbook voor bestemming in een holder. was actieve werkboek op het moment
'dat de code werd gestart.
Set totalwb = ActiveWorkbook
'zolang er bestanden zijn die aan criteria voldoen
Do While fileName <> ""
'vul mywb met eerste bestand
Set mywb = Workbooks.Open(mydir & myfile)
'ga door al de worksheets in een workbook en nosheets
'wordt gebruikt als index
For nosheets = 1 To mywb.Worksheets.Count
'zet een holder voor 1ste worksheet
Set mysheet = mywb.Worksheets(nosheets)
'copieer worksheet naar bestemmeling als laatste werkblad
mysheet.Copy after:=totalwb.Worksheets(Worksheets.Count)
'volgende worksheet in bestand
Next nosheets
'sluit het bestand
mywb.Close
'ga naar volgende bestand
myfile = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Charlize

ps.: Waarom post je dit ook in het engelse forum ?

Decision
12-03-2014, 04:10 AM
Hi Charlize, wist niet of er veel Nederlandse toeschouwers zouden zijn! Zal het voortaan op een forum posten. Andere vraag.. Zou je kunnen helpen met onderstaande code, ik krijg een 1004 error melding voor het volgende gedeelte:

Range("A3").Select
ActiveSheet.PivotTables("PivotTable1").PivotSelect "", xlDataAndLabel, True
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveWindow.ScrollRow = 2

De pivot heet 'PivotTable1' en staat in een sheet genaamd 'Pivot FTL Coded'. Deze Pivot wil ik eerst refreshen, kopieren en special pasten in een andere sheet genaamd 'Quotation Template (1)', zodat het geen pivot meer is. Kun je misschien helpen? Bvd!!