PDA

View Full Version : Need help transfering data into another workbook



Spike69
08-02-2007, 07:15 AM
(1) Open All Analysis files, that is located at ?C:\conv\Analyze?
(2) Select cell ?A3? in Range of data in order to determine if that cell contains data.
(3) If Cell ?A3? does not contain data move down to next cell with data (Copy that cell and paste that value into a workbook called ?DataEchantillon.xls?.
(4) This procedure needs to be done to every open Analysis file >> In order to check in the range of data of column ?A? If the cells contain blank values, If it does then move down to next cell with data and copy it to the file called ?DataEchantillon.xls? of columns ?B? And ?G?.
(5) I need to copy one value at a time into a specific Area of the ?DataEchantillon.xls? File.
(6) Loop through every cell in column ?A? of Analysis until end of range of data.
(7) Save And close the ?DataEchantillon.xls? File.


If anyone could please help me it would be very much appreciated thank you??

rory
08-02-2007, 07:21 AM
Try this:

Sub dataTransfer()
Dim wkbData As Workbook
Dim cell As Range
Dim Fichiers() As String, nomFichier As String, myPath As String, myFile As String
Dim i As Integer, NBFichier As Integer
Dim wks As Worksheet
Dim rngTarget As Range, rngCell As Range
Dim lngLastRow As Long

myPath = "C:\conv\Analyze\"
myFile = Dir(myPath & "*.xls")
i = 0
Do While myFile <> ""
ReDim Preserve Fichiers(i)
Fichiers(i) = myFile
i = i + 1
myFile = Dir
Loop
NBFichier = UBound(Fichiers) + 1
nomFichier = Cells(2, 1)

' Opens all Analysis files
Set rngTarget = ActiveSheet.Cells(3, "B")
For i = LBound(Fichiers) To UBound(Fichiers)
Set wkbData = Workbooks.Open(Filename:=myPath & Fichiers(i), ReadOnly:=True)
' Check sheet exists
On Error Resume Next
Set wks = wkbData.Worksheets(nomFichier)
If Not wks Is Nothing Then
lngLastRow = wks.Range("A65536").End(xlUp).Row
' make sure there is data in row 3 or below
If lngLastRow > 2 Then
For Each rngCell In wks.Range(wks.Range("A3"), wks.Cells(lngLastRow, "A"))
If Len(Trim$(rngTarget.Value)) > 0 Then
Union(rngTarget, rngTarget.Offset(0, 5)).Value = rngCell.Value
Set rngTarget = rngTarget.Offset(1, 0)
End If
Next rngCell
End If
End If
wkbData.Close False
Next i
wks.Parent.Save
End Sub


Regards,
Rory

Spike69
08-02-2007, 07:27 AM
is this the same code as before

Spike69
08-02-2007, 07:30 AM
it seems to do something but except the most important step which is transfer the data into "DataEchantillon.xls".....

rory
08-02-2007, 07:30 AM
Yes, the code also assumes that the DataEchantillon workbook is open and active when you run it.
Regards,
Rory

Spike69
08-02-2007, 07:31 AM
nope nothing is written in the file

rory
08-02-2007, 07:40 AM
Where is the nomFichier value supposed to come from?

Spike69
08-02-2007, 07:41 AM
that is retreiving the sheet name within the analysis files

rory
08-02-2007, 07:46 AM
I know that and I know it comes from cell A2, but in which sheet of which workbook?

Spike69
08-02-2007, 07:48 AM
the last Analysis file that opens I was orginally using that value in order to do my for each loop

Spike69
08-02-2007, 07:48 AM
sheet 1 i imagine

Spike69
08-02-2007, 07:55 AM
if its too complicated nm.. i dont want to keep you away from anything important

rory
08-02-2007, 08:01 AM
Are you always taking the data from the first sheet in each of the analysis workbooks?

Spike69
08-02-2007, 08:05 AM
all i know is that i need to open all the analysis files check in column A after cell("A3") to the end of my range in order to copy the values in that column one by one into the file DataEchantillon in columns "B" and "G".

in doing so checking to see if there are any blank values in the range of the analysis files. if there are blanks then i want it to move down to the first data value and copy that value into the file DataEchantillon, right until the end of column A.

rory
08-02-2007, 08:08 AM
You must know which sheet you look at in the analysis files! Is it the first one, the only one, one with a specific name??

Spike69
08-02-2007, 08:12 AM
i need all of the sheets to transfer into the file dataEchantillon..
with the criteria i mentioned above

all the sheets that open from "c:\conv\Analyze\"

but in order to use the sheet name i have created the variable nomFichier

which is what retreives the open sheetname

Spike69
08-02-2007, 08:27 AM
well i guess its too complicated then thanks for helping though, if ever you find a solution let me know thank-you

rory
08-02-2007, 08:28 AM
I don't think we're understanding each other. I know that you want to open all the workbooks in that directory and copy the data into DataEchantillon.xls; I need to know which worksheet within each workbook you want to copy from, or is there only one sheet in each workbook?

Spike69
08-02-2007, 08:30 AM
there is only one sheet in each workbook

Spike69
08-02-2007, 08:42 AM
is it clear now.....

rory
08-02-2007, 08:46 AM
OK, try this:

Sub dataTransfer()
Dim wkbData As Workbook
Dim cell As Range
Dim Fichiers() As String, nomFichier As String, myPath As String, myFile As String
Dim i As Integer, NBFichier As Integer
Dim wks As Worksheet
Dim rngTarget As Range, rngCell As Range
Dim lngLastRow As Long

myPath = "C:\conv\Analyze\"
myFile = Dir(myPath & "*.xls")
i = 0
Do While myFile <> ""
ReDim Preserve Fichiers(i)
Fichiers(i) = myFile
i = i + 1
myFile = Dir
Loop
NBFichier = UBound(Fichiers) + 1
nomFichier = Cells(2, 1)

' Opens all Analysis files
Set rngTarget = Workbooks("DataEchantillon.xls").Worksheets(1).Cells(3, "B")
For i = LBound(Fichiers) To UBound(Fichiers)
Set wkbData = Workbooks.Open(Filename:=myPath & Fichiers(i), ReadOnly:=True)
' Check sheet exists
Set wks = wkbData.Worksheets(1)
lngLastRow = wks.Range("A65536").End(xlUp).Row
' make sure there is data in row 3 or below
If lngLastRow > 2 Then
For Each rngCell In wks.Range(wks.Range("A3"), wks.Cells(lngLastRow, "A"))
If Len(Trim$(rngTarget.Value)) > 0 Then
Union(rngTarget, rngTarget.Offset(0, 5)).Value = rngCell.Value
Set rngTarget = rngTarget.Offset(1, 0)
End If
Next rngCell
End If
wkbData.Close False
Next i
rngTarget.Parent.Close True
End Sub


Regards,
Rory

Spike69
08-02-2007, 08:51 AM
i really dont get it there still isnt any data that is written inside the file dataEchantillon.....

Spike69
08-02-2007, 08:52 AM
it seems by the code you have sent me that there isnt any data being cpied and pasted

rory
08-02-2007, 09:02 AM
Sorry - stupid typo on my part! Try this:
Sub dataTransfer()
Dim wkbData As Workbook
Dim cell As Range
Dim Fichiers() As String, nomFichier As String, myPath As String, myFile As String
Dim i As Integer, NBFichier As Integer
Dim wks As Worksheet
Dim rngTarget As Range, rngCell As Range
Dim lngLastRow As Long

myPath = "C:\conv\Analyze\"
myFile = Dir(myPath & "*.xls")
i = 0
Do While myFile <> ""
ReDim Preserve Fichiers(i)
Fichiers(i) = myFile
i = i + 1
myFile = Dir
Loop
NBFichier = UBound(Fichiers) + 1
nomFichier = Cells(2, 1)

' Opens all Analysis files
Set rngTarget = Workbooks("DataEchantillon.xls").Worksheets(1).Cells(3, "B")
For i = LBound(Fichiers) To UBound(Fichiers)
Set wkbData = Workbooks.Open(Filename:=myPath & Fichiers(i), ReadOnly:=True)
' Check sheet exists
Set wks = wkbData.Worksheets(1)
lngLastRow = wks.Range("A65536").End(xlUp).Row
' make sure there is data in row 3 or below
If lngLastRow > 2 Then
For Each rngCell In wks.Range(wks.Range("A3"), wks.Cells(lngLastRow, "A"))
If Len(Trim$(rngCell.Value)) > 0 Then
Union(rngTarget, rngTarget.Offset(0, 5)).Value = rngCell.Value
Set rngTarget = rngTarget.Offset(1, 0)
End If
Next rngCell
End If
wkbData.Close False
Next i
rngTarget.Parent.Parent.Close True
End Sub


Regards,
Rory

Spike69
08-02-2007, 09:03 AM
it works yayyyyyyyyyyyyyyyyyaaaa

thankyou so much

rory
08-02-2007, 09:05 AM
Glad we got there in the end! :)
Rory

Spike69
08-02-2007, 09:06 AM
it glad to you i have it done thank-you so much for your time i appreciate it alot

Spike69
08-02-2007, 09:09 AM
you cannot believe how much weight that took off my shoulders thanks a million

rory
08-02-2007, 09:14 AM
No problem!
Rory