variabele cel en variabele bestandsnaam in macro

Status
Niet open voor verdere reacties.

Kristinho78

Gebruiker
Lid geworden
18 nov 2013
Berichten
8
Hallo allemaal,


Ik heb een groot excelbestand met een tabel van vele duizenden regels en twee relevante kolommen (C en G).
Graag zou ik een macro hebben die voor elke gevulde cel in kolom C een excelbestandje aanmaakt en hieraan de naam geeft die in kolom G (op dezelfde regel) staat.

Ik heb een klein begin gemaakt:

Sub veelbestandjes()
Range("C2").Select
Selection.Copy
Workbooks.Add
Application.WindowState = xlNormal
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="H:\Opdracht\inhoudvanG2.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End Sub


De Range("C2").Select zou dus bij elk bestandje dat aangemaakt wordt, een regelnummer moeten ophogen.
Datzelfde geldt voor bestandsnaam H:\Opdracht\inhoudvanG2.xlsx.

Wie kan me helpen?


Groeten Kris
 
Weet je zeker dat van alle gevulde cellen in kolom G de inhoud zodanig is dat dit ook als bestandsnaam door Windows wordt geaccepteerd?

Je zou dan zoiets kunnen doen:
Code:
Sub veelbestandjes()
    Dim i As Long
    Dim InhoudC As String
    Dim InhoudG As String
    Dim LastRow As Long
    
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    End With
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False        

    For i = 1 To LastRow
        If Cells(i, 3) <> "" Then
            InhoudC = Cells(i, 3)
            InhoudG = Cells(i, 7)
            Application.StatusBar = "Bezig met " & i & " van " & LastRow & " - " & InhoudG
            'Application.Wait (Now + TimeValue("0:00:01"))
            Workbooks.Add
            Cells(1, 1) = InhoudC
            ActiveWorkbook.SaveAs Filename:="H:\Opdracht\" & InhoudG & ".xlsx", FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWindow.Close
        End If
    Next i

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.StatusBar = False

End Sub

Omdat dat nogal wat tijd gaat kosten vanwege het opslaan van veel bestanden kun je in de statusbar van het hoofd document de voortgang zien.
 
Laatst bewerkt:
Graag gedaan :)
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan