How do I Import a spreed sheet

  • Thread starter jln via OfficeKB.com
  • Start date
J

jln via OfficeKB.com

OK what i have is for spread sheets they are all named with a number_1 .
There are always4 files for each number. When each file imports I Need 1 to
be called sheet 2 2 to be 3 3 to be 4 and 4 to be 5. Sheet 1 is my template.
Here is the code im using to import one at a time.

Sub Import_AA_Tabs()


Dim CurWks As Worksheet
Dim myWkbk As Workbook
Dim myFileName As Variant
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng As Range
Dim LastRow As Long


Sheets.Add ' add a blank sheet

Set CurWks = ActiveSheet 'or whatever you want it to be
'code to get the name and open the .csv file



myFileName = Application.GetOpenFilename(filefilter:="xls Files, *.Xls",
_
Title:="Pick a File")

If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

Workbooks.Open FileName:=myFileName '....rest of recorded code here!

Set myWkbk = ActiveWorkbook

myWkbk.Worksheets(1).UsedRange.Copy _
Destination:=CurWks.Range("a1")
'(Paste into A1 of the original sheet????)

'close the .csv file without making changes
myWkbk.Close savechanges:=False



End Sub
 
G

Guest

The code uses the worksheet name of the original worksheet to make the other
sheet names

sheet 1 = jln
then new sheets are
jln_1
jln_2
jln_3
jln_4


Sub Import_AA_Tabs()

Dim CurWks As Worksheet
Dim myWkbk As Workbook
Dim myFileName As Variant
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng As Range
Dim LastRow As Long



'code to get the name and open the .csv file
For fileNum = 1 To 4

ThisWorkbook.Activate
Sheets.Add ' add a blank sheet
Set CurWks = ActiveSheet 'or whatever you want it to be
ActiveSheet.Name = CurWks.Name & "_" & (fileNum + 1)


myFileName = Application. _
GetOpenFilename(filefilter:="xls Files, *.Xls", _
Title:="Pick a File")

If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

Workbooks.Open Filename:=myFileName '....rest of recorded code here!

Set myWkbk = ActiveWorkbook

myWkbk.Worksheets(1).UsedRange.Copy _
Destination:=CurWks.Range("a1")
'(Paste into A1 of the original sheet????)

'close the .csv file without making changes
myWkbk.Close savechanges:=False

Next fileNum

End Sub
 
J

jln via OfficeKB.com

The worksheet name works the way it is, what im really trying to get is how
get just the 4 files that i need? the file names look like this 641_1, 641_2,
641_3, 641_4 so i would want to loop thought just those 4 files and stop.
The code uses the worksheet name of the original worksheet to make the other
sheet names

sheet 1 = jln
then new sheets are
jln_1
jln_2
jln_3
jln_4

Sub Import_AA_Tabs()

Dim CurWks As Worksheet
Dim myWkbk As Workbook
Dim myFileName As Variant
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng As Range
Dim LastRow As Long

'code to get the name and open the .csv file
For fileNum = 1 To 4

ThisWorkbook.Activate
Sheets.Add ' add a blank sheet
Set CurWks = ActiveSheet 'or whatever you want it to be
ActiveSheet.Name = CurWks.Name & "_" & (fileNum + 1)


myFileName = Application. _
GetOpenFilename(filefilter:="xls Files, *.Xls", _
Title:="Pick a File")

If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

Workbooks.Open Filename:=myFileName '....rest of recorded code here!

Set myWkbk = ActiveWorkbook

myWkbk.Worksheets(1).UsedRange.Copy _
Destination:=CurWks.Range("a1")
'(Paste into A1 of the original sheet????)

'close the .csv file without making changes
myWkbk.Close savechanges:=False

Next fileNum

End Sub
OK what i have is for spread sheets they are all named with a number_1 .
There are always4 files for each number. When each file imports I Need 1 to
Click to expand...
[quoted text clipped - 43 lines]
End Sub
Click to expand...
Click to expand...
 
G

Guest

I made some changges so you only have to select 1 file name and it will get
the other 3 files

Sub Import_AA_Tabs()

Dim CurWks As Worksheet
Dim MyWkbk As Workbook
Dim MyFilename As String
Dim MyPath As String
Dim NewFileName As String
Dim RootFileName As String
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng As Range
Dim LastRow As Long


MyFilename = Application. _
GetOpenFilename(filefilter:="xls Files, *.Xls", _
Title:="Pick a File (any file _1, _2, _3, _4")
MyPath = ""
Do While InStr(MyFilename, "\") > 0
MyPath = MyPath & Left(MyFilename, InStr(MyFilename, "\"))
MyFilename = Mid(MyFilename, InStr(MyFilename, "\") + 1)
Loop
'remove _1 and extension from filename
If InStr(MyFilename, "_") > 0 Then
RootFileName = Left(MyFilename, InStr(MyFilename, "_") - 1)
Else
RootFileName = Left(MyFilename, InStr(MyFilename, ".") - 1)
End If

'code to get the name and open the .csv file
For filenum = 1 To 4

ThisWorkbook.Activate
Sheets.Add ' add a blank sheet
Set CurWks = ActiveSheet 'or whatever you want it to be
ActiveSheet.Name = RootFileName & "_" & (filenum)


NewFileName = MyPath & RootFileName & "_" & _
(filenum) & ".xls"
If Dir(NewFileName) = "" Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

Workbooks.Open Filename:=NewFileName '....rest of recorded code here!

Set MyWkbk = ActiveWorkbook

MyWkbk.Worksheets(1).UsedRange.Copy _
Destination:=CurWks.Range("a1")
'(Paste into A1 of the original sheet????)

'close the .csv file without making changes
MyWkbk.Close savechanges:=False

Next filenum

End Sub



jln via OfficeKB.com said:
The worksheet name works the way it is, what im really trying to get is how
get just the 4 files that i need? the file names look like this 641_1, 641_2,
641_3, 641_4 so i would want to loop thought just those 4 files and stop.
The code uses the worksheet name of the original worksheet to make the other
sheet names

sheet 1 = jln
then new sheets are
jln_1
jln_2
jln_3
jln_4

Sub Import_AA_Tabs()

Dim CurWks As Worksheet
Dim myWkbk As Workbook
Dim myFileName As Variant
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng As Range
Dim LastRow As Long

'code to get the name and open the .csv file
For fileNum = 1 To 4

ThisWorkbook.Activate
Sheets.Add ' add a blank sheet
Set CurWks = ActiveSheet 'or whatever you want it to be
ActiveSheet.Name = CurWks.Name & "_" & (fileNum + 1)


myFileName = Application. _
GetOpenFilename(filefilter:="xls Files, *.Xls", _
Title:="Pick a File")

If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

Workbooks.Open Filename:=myFileName '....rest of recorded code here!

Set myWkbk = ActiveWorkbook

myWkbk.Worksheets(1).UsedRange.Copy _
Destination:=CurWks.Range("a1")
'(Paste into A1 of the original sheet????)

'close the .csv file without making changes
myWkbk.Close savechanges:=False

Next fileNum

End Sub
OK what i have is for spread sheets they are all named with a number_1 .
There are always4 files for each number. When each file imports I Need 1 to
Click to expand...
[quoted text clipped - 43 lines]
End Sub
Click to expand...
Click to expand...
Click to expand...
 
J

jln via OfficeKB.com

When I run your code its not adding a sheet or pasting it. I dont get an
error either. I have steped though the code as well and i dont see the sheet
getting added or the pasted.
I made some changges so you only have to select 1 file name and it will get
the other 3 files

Sub Import_AA_Tabs()

Dim CurWks As Worksheet
Dim MyWkbk As Workbook
Dim MyFilename As String
Dim MyPath As String
Dim NewFileName As String
Dim RootFileName As String
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng As Range
Dim LastRow As Long

MyFilename = Application. _
GetOpenFilename(filefilter:="xls Files, *.Xls", _
Title:="Pick a File (any file _1, _2, _3, _4")
MyPath = ""
Do While InStr(MyFilename, "\") > 0
MyPath = MyPath & Left(MyFilename, InStr(MyFilename, "\"))
MyFilename = Mid(MyFilename, InStr(MyFilename, "\") + 1)
Loop
'remove _1 and extension from filename
If InStr(MyFilename, "_") > 0 Then
RootFileName = Left(MyFilename, InStr(MyFilename, "_") - 1)
Else
RootFileName = Left(MyFilename, InStr(MyFilename, ".") - 1)
End If

'code to get the name and open the .csv file
For filenum = 1 To 4

ThisWorkbook.Activate
Sheets.Add ' add a blank sheet
Set CurWks = ActiveSheet 'or whatever you want it to be
ActiveSheet.Name = RootFileName & "_" & (filenum)


NewFileName = MyPath & RootFileName & "_" & _
(filenum) & ".xls"
If Dir(NewFileName) = "" Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

Workbooks.Open Filename:=NewFileName '....rest of recorded code here!

Set MyWkbk = ActiveWorkbook

MyWkbk.Worksheets(1).UsedRange.Copy _
Destination:=CurWks.Range("a1")
'(Paste into A1 of the original sheet????)

'close the .csv file without making changes
MyWkbk.Close savechanges:=False

Next filenum

End Sub
The worksheet name works the way it is, what im really trying to get is how
get just the 4 files that i need? the file names look like this 641_1, 641_2,
Click to expand...
[quoted text clipped - 61 lines]
Click to expand...
 
G

Guest

Strange. There are only 5 different results you can get

1) Everything works. The program creates 4 new worksheets
2) The worksheets already exist. You get a run time error 1004
3) The filename doesn't exist. A message box appears saying "OK, try later)
4) Macros are disabled in this workbook.
5) You enter cancel On the File pop up window. An error code is generated.


I'm using your original code with only slight modifications. You are not
getting any of the above failures or success. Have you tried running the
code more than once??? Should get error 2.

I would save and close excel. Then re-open the file and try running it
again. make sure you enxbled macros.

Also check you security level to make sure it not set to high or very high.
Go to Tools Menu - Macro - security.

jln via OfficeKB.com said:
When I run your code its not adding a sheet or pasting it. I dont get an
error either. I have steped though the code as well and i dont see the sheet
getting added or the pasted.
I made some changges so you only have to select 1 file name and it will get
the other 3 files

Sub Import_AA_Tabs()

Dim CurWks As Worksheet
Dim MyWkbk As Workbook
Dim MyFilename As String
Dim MyPath As String
Dim NewFileName As String
Dim RootFileName As String
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng As Range
Dim LastRow As Long

MyFilename = Application. _
GetOpenFilename(filefilter:="xls Files, *.Xls", _
Title:="Pick a File (any file _1, _2, _3, _4")
MyPath = ""
Do While InStr(MyFilename, "\") > 0
MyPath = MyPath & Left(MyFilename, InStr(MyFilename, "\"))
MyFilename = Mid(MyFilename, InStr(MyFilename, "\") + 1)
Loop
'remove _1 and extension from filename
If InStr(MyFilename, "_") > 0 Then
RootFileName = Left(MyFilename, InStr(MyFilename, "_") - 1)
Else
RootFileName = Left(MyFilename, InStr(MyFilename, ".") - 1)
End If

'code to get the name and open the .csv file
For filenum = 1 To 4

ThisWorkbook.Activate
Sheets.Add ' add a blank sheet
Set CurWks = ActiveSheet 'or whatever you want it to be
ActiveSheet.Name = RootFileName & "_" & (filenum)


NewFileName = MyPath & RootFileName & "_" & _
(filenum) & ".xls"
If Dir(NewFileName) = "" Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If

Workbooks.Open Filename:=NewFileName '....rest of recorded code here!

Set MyWkbk = ActiveWorkbook

MyWkbk.Worksheets(1).UsedRange.Copy _
Destination:=CurWks.Range("a1")
'(Paste into A1 of the original sheet????)

'close the .csv file without making changes
MyWkbk.Close savechanges:=False

Next filenum

End Sub
The worksheet name works the way it is, what im really trying to get is how
get just the 4 files that i need? the file names look like this 641_1, 641_2,
Click to expand...
[quoted text clipped - 61 lines]
End Sub
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

macro to copy and paste 1
Copy from one workbook to another failing 8
Code Improvements 6
sumproduct in vba 3
Subscript out or Ranger Error 9 - I'm lost here! 1
Do loop until, step down row - copy paste - not what it seems. 0
Help in Getting the File Name from a path 3
How to save with a name in a particular cell? 2

Top