Spalte automatisch hinzufügen wenn in Zelle A1 Eintrag

[Petz1807]

Hallo,

Kann einer mir sagen oder mir im folgenden VBA den Eintrag hinzufügen dass fals was in Zelle A1 steht automatisch links eine Spalte hinzugefügt wird

Vielen lieben Dank

Code:

Sub DateienAuflisten()
Dim strPfad As String
Dim lngZeile As Long
Dim strDatei As String
lngZeile = 1
Application.ScreenUpdating = False
strPfad = GetFolder
strDatei = Dir(strPfad & "\")
If strPfad <> "" Then
Do
Cells(lngZeile, 1) = strDatei
strDatei = Dir
lngZeile = lngZeile + 1
Loop While strDatei <> ""
End If
Application.ScreenUpdating = True
End Sub


Function GetFolder() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialFileName = "C:\"
.ButtonName = "OK  :-)"
.Title = "Datei finden"
.Show
If .SelectedItems.Count = 0 Then
GetFolder = ""
Else
GetFolder = .SelectedItems(1)
End If
End With
End Function

[Werner.M]

Hallo,

so:

Code:

Sub DateienAuflisten()
Dim strPfad As String, lngZeile As Long, strDatei As String

lngZeile = 1
Application.ScreenUpdating = False

strPfad = GetFolder
strDatei = Dir(strPfad & "\")

If strPfad <> "" Then
   If Cells(1, 1) <> "" Then Columns("A").Insert
   Do
       Cells(lngZeile, 1) = strDatei
       strDatei = Dir
       lngZeile = lngZeile + 1
   Loop While strDatei <> ""
End If

End Sub

Gruß Werner

[Klaus-Dieter]

Hallo,

versuche es mal damit:

Code:

Sub DateienAuflisten()
   Dim strPfad As String
   Dim lngZeile As Long
   Dim strDatei As String
   Dim intSp As Integer
   intSp = 1
   lngZeile = 1
   If Range("A1") <> "" Then intSp = 2
   Application.ScreenUpdating = False
   strPfad = GetFolder
   strDatei = Dir(strPfad & "\")
   If strPfad <> "" Then
       Do
           Cells(lngZeile, intSp) = strDatei
           strDatei = Dir
           lngZeile = lngZeile + 1
       Loop While strDatei <> ""
   End If
   Application.ScreenUpdating = True
End Sub


Function GetFolder() As String
   With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .InitialFileName = "C:\"
       .ButtonName = "OK  :-)"
       .Title = "Datei finden"
       .Show
       If .SelectedItems.Count = 0 Then
           GetFolder = ""
       Else
           GetFolder = .SelectedItems(1)
       End If
   End With
End Function

[Petz1807]

Hat geklappt vielen lieben Dank )))