Modify code to import to all worksheets

[gnoke]

Hi,

I am using the following code to import all files in a directory.
Could someone please assist me in modifying the code, so that the imported files is pasted in all worksheets, not just the first (sheet1)?

Sub Importere_filer()
Dim mnthNum As Integer
Dim myBook As Workbook
Dim myRows As Long

With Application
    .DisplayAlerts = False
    .EnableEvents = False
    .ScreenUpdating = False
End With

With Application.FileSearch
    .NewSearch
    'Change this to your directory
    On Error GoTo ErrHandler:
    .LookIn = "H:\div\"
    .SearchSubFolders = False
    .Filename = "*.txt"
    If .Execute() > 0 Then
        For i = 1 To .FoundFiles.Count
            Workbooks.OpenText .FoundFiles(i), , , xlDelimited, , , , True
            Set myBook = ActiveWorkbook
            myRows = ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Row + 1
                ActiveSheet.UsedRange.Copy _
                ThisWorkbook.Worksheets(1).Cells(myRows, 1)
                myRows = myRows + 1
            myBook.Close
         Next i
    End If

ErrHandler:
End With

With Application
    .DisplayAlerts = True
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

Duplicate: http://www.mrexcel.com/forum/showthread.php?t=484275

Gnoke

[Bob Phillips]

Untested

Sub Importere_filer()
Dim mnthNum As Integer
Dim myBook As Workbook
Dim myRows As Long
Dim NextRow As Long
Dim i As Long, j As Long

	With Application
		.DisplayAlerts = False
		.EnableEvents = False
		.ScreenUpdating = False
	End With

	With Application.FileSearch
		.NewSearch
		'Change this to your directory
		On Error GoTo ErrHandler:
		.LookIn = "H:\div\"
		.SearchSubFolders = False
		.Filename = "*.txt"
		If .Execute() > 0 Then
			For i = 1 To .FoundFiles.Count
				Workbooks.OpenText .FoundFiles(i), , , xlDelimited, , , , True
				Set myBook = ActiveWorkbook
				For j = 1 To myBook.Worksheets.Count
					myRows = ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Rows.Count).End(xlUp).Row + 1
					myBook.Worksheets(j).UsedRange.Copy _
					ThisWorkbook.Worksheets(1).Cells(myRows, 1)
					myRows = myRows + 1
				myBook.Close
			 Next i
		End If

	ErrHandler:
	End With

	With Application
		.DisplayAlerts = True
		.EnableEvents = True
		.ScreenUpdating = True
	End With

End Sub

[gnoke]

Thanks for replay!

I get the following error: "Invalid Next control variable reference" on line number 10 from the buttom "Next i"
Any ideas?

[Bob Phillips]

I forgot to close my new loop

Sub Importere_filer()
Dim mnthNum As Integer
Dim myBook As Workbook
Dim myRows As Long
Dim NextRow As Long
Dim i As Long, j As Long

	With Application
		.DisplayAlerts = False
		.EnableEvents = False
		.ScreenUpdating = False
	End With

	With Application.FileSearch
		.NewSearch
		'Change this to your directory
		On Error GoTo ErrHandler:
		.LookIn = "H:\div\"
		.SearchSubFolders = False
		.Filename = "*.txt"
		If .Execute() > 0 Then
			For i = 1 To .FoundFiles.Count
				Workbooks.OpenText .FoundFiles(i), , , xlDelimited, , , , True
				Set myBook = ActiveWorkbook
				For j = 1 To myBook.Worksheets.Count
					myRows = ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Rows.Count).End(xlUp).Row + 1
					myBook.Worksheets(j).UsedRange.Copy _
					ThisWorkbook.Worksheets(1).Cells(myRows, 1)
					myRows = myRows + 1
				Next j
				myBook.Close
			 Next i
		End If

	ErrHandler:
	End With

	With Application
		.DisplayAlerts = True
		.EnableEvents = True
		.ScreenUpdating = True
	End With

End Sub

[gnoke]

Thanks again for your replay!

Now the macro runs, but I see no differens in the output compared to the prior macro.
The text files are not imported to any sheets except the first...

Ideas someone?

[gnoke]

Anyone else that have any ideas?
Would reallt appreciate any further assistance

[Bob Phillips]

Maybe I misunderstood the brief. Try this version

Sub Importere_filer()
Dim mnthNum As Long
Dim myRows As Long
Dim NextRow As Long
Dim i As Long, j As Long

    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    With Application.FileSearch
        .NewSearch
        'Change this to your directory
        On Error GoTo ErrHandler:
        .LookIn = "H:\div\"
        .SearchSubFolders = False
        .Filename = "*.txt"
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                Workbooks.OpenText .FoundFiles(i), , , xlDelimited, , , , True
                For j = 1 To ThisWorkbook.Worksheets.Count
                    myRows = ThisWorkbook.Worksheets(j).Range("A" & _
                        ThisWorkbook.Worksheets(j).Rows.Count).End(xlUp).Row + 1
                    ActiveSheet.UsedRange.Copy _
                        ThisWorkbook.Worksheets(j).Cells(myRows, 1)
                Next j
                myBook.Close
             Next i
        End If
        
ErrHandler:
    End With

    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

[gnoke]

Hi and thanks again Bob!

We are defininitly getting somewhere now, but still have two issues.
1. The macro imports to all sheets nicely, but only one text file, not all text files in the specified folder.
2. The single text file is also imported to a new workbook...

Gnoke

[gnoke]

Solution for me:

1. I use this code to import all text files into a single sheet:

Sub Import_Text()
Dim mnthNum As Integer
Dim myBook As Workbook
Dim myRows As Long

With Application
    .DisplayAlerts = False
    .EnableEvents = False
    .ScreenUpdating = False
End With

With Application.FileSearch
    .NewSearch
    'Change this to your directory
    On Error GoTo ErrHandler:
    .LookIn = "C:\sample\"
    .SearchSubFolders = False
    .Filename = "*.txt"
    If .Execute() > 0 Then
        For i = 1 To .FoundFiles.Count
            Workbooks.OpenText .FoundFiles(i), , , xlDelimited, , , , True
            Set myBook = ActiveWorkbook
            myRows = ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Row + 1
                ActiveSheet.UsedRange.Copy _
                ThisWorkbook.Worksheets(1).Cells(myRows, 1)
                myRows = myRows + 1
            myBook.Close
         Next i
    End If

2. Then i created new macros to delete rows with specific values in specific cells (or else delete rows with empty cells).
3. Then I recorded simple macros to e.g. arrange the rows ascending based text in column A.
4. In the end I recorded a macro while running all the simple macros.

This is probably not the most efficient for my job, but it does what I need
Thanks for all help!
Gnoke