Copy data from many files.

[Corall]

Howdy,

How can I copy data from multiple files (between 2 and 5 files) from a folder on my desktop?
Every day I have to copy data, which are not arranged identically in each file, from sheet1 (each file has only one sheet), of each file found in the WORK folder.
In a file the data can be in the range C3: BA175, in another, in the range F5: AZ220 and so on (the first data row is the column name, C3: BA3 or F5: AZ5 etc ...).
I would like to copy that data (the data in each file will be copied in separate sheets, in the file where I run the VBA code).
Since the data is not identical in all files, I would like the "Name" column (which can be a rice column) to be copied to column A (starting with A2) and then all other columns.

Ex: In file 1, the data is in Range C3: BA175, the column "NAME" is - let's say - in Column D (in C3: BA3 are headers, and in D3 is "NAME"). This column will be copied to column A (A2), of each sheet (from the centralizing file) and then the other columns will be copied to B2: BA2.
If in file 2 the data is in the range F5: AZ220 and the column "NAME" is - let's say - in K5, the data will be copied to another sheet, but the column "NAME" will be copied to column A (A2).

Very complicated.
If someone can help me...
Thank you in advance.

 

[DanteAmor]

Hi @★ Corall , welcome to the forum.

Let's start whit this.

Change C:\books\, by the name of your folder.

Sub Copy_data()
  Dim wFiles As Variant, wFolder As String
  Dim wb1 As Workbook, wb2 As Workbook, sh2 As Worksheet, sh1 As Worksheet
  Dim lr As Long, lc As Long, f As Range
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set wb1 = ThisWorkbook
  wFolder = "[COLOR=#ff0000]C:\books\[/COLOR]"
  If Right(wFolder, 1) <> "\" Then wFolder = wFolder & "\"
  If Dir(wFolder, vbDirectory) = "" Then
    MsgBox "Folder does not exist"
    Exit Sub
  End If
  wFiles = Dir(wFolder & "*.xls*")
  Do While wFiles <> ""
    Set wb2 = Workbooks.Open(wFolder & wFiles)
    Set sh2 = wb2.Sheets(1)
    Set f = sh2.Cells.Find("NAME", , xlValues, xlWhole)
    If Not f Is Nothing Then
      lr = sh2.Cells(Rows.Count, f.Column).End(xlUp).Row
      lc = sh2.Cells(f.Row, Columns.Count).End(xlToLeft).Column
      sh2.Range(f, sh2.Cells(lr, lc)).Copy
      wb1.Sheets.Add after:=wb1.Sheets(wb1.Sheets.Count)
      Set sh1 = wb1.ActiveSheet
      sh1.Range("A2").PasteSpecial xlPasteValues
    End If
    wb2.Close False
    wFiles = Dir()
  Loop
  Application.ScreenUpdating = True
  MsgBox "End"
End Sub

 

[Corall]

Hi, DanteAmor, Thanks for the welcome and for the code, but the code only copies the data range from the "Name" column to the right. I need to copy all the data, including those to the left of the "Name" column. The code should look for the column with the name "Name", copy it and put it in column A (starting with A2) and then copy the other columns (from B2 to the last column). In the files where it is copied, there is just that data and nothing else. Thank you very much for your help.

<tbody>
</tbody>

 

[DanteAmor]

In the archives there is always information in column A?

 

[Corall]

In the archives there is always information in column A Sheet1. Nothing will be copied in Sheet1
But all data will be copied in new sheets created, starting with sheet2..sheet3...
The copied data will be added in blank sheets, which will be created depending on how many files will be in the "books" folder. One sheet for each file.

 

[DanteAmor]

Try this

In file 1, the data is in Range C3:BA175 (If as you comment in post #5 there is always data in column A, then the range is A3:BA175)

the column "NAME" is in Column D. This column will be copied to column A (A2), and then the other columns will be copied to B2:BA2

If you want to copy the columns on the left and also those on the right, but you don't mention in your example what to do with column D.


In the following macro, following your example, column D is copied and pasted into column A and all columns from A to BA are copied and pasted starting at column B. (Column D will be repeated.)

Sub Copy_data()
  Dim wFiles As Variant, wFolder As String
  Dim wb1 As Workbook, wb2 As Workbook, sh2 As Worksheet, sh1 As Worksheet
  Dim lr As Long, lc As Long, f As Range
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set wb1 = ThisWorkbook
  wFolder = "C:\trabajo\books\"
  If Right(wFolder, 1) <> "\" Then wFolder = wFolder & "\"
  If Dir(wFolder, vbDirectory) = "" Then
    MsgBox "Folder does not exist"
    Exit Sub
  End If
  wFiles = Dir(wFolder & "*.xls*")
  Do While wFiles <> ""
    Set wb2 = Workbooks.Open(wFolder & wFiles)
    Set sh2 = wb2.Sheets(1)
    Set f = sh2.Cells.Find("NAME", , xlValues, xlWhole)
    If Not f Is Nothing Then
      lr = sh2.Cells(Rows.Count, f.Column).End(xlUp).Row
      lc = sh2.Cells(f.Row, Columns.Count).End(xlToLeft).Column
      wb1.Sheets.Add after:=wb1.Sheets(wb1.Sheets.Count)
      Set sh1 = wb1.ActiveSheet
      sh2.Range(f, sh2.Cells(lr, f.Column)).Copy
      sh1.Range("A2").PasteSpecial xlPasteValues
      sh2.Range(sh2.Cells(f.Row, "A"), sh2.Cells(lr, lc)).Copy
      sh1.Range("B2").PasteSpecial xlPasteValues
    End If
    wb2.Close False
    wFiles = Dir()
  Loop
  Application.ScreenUpdating = True
  MsgBox "End"
End Sub

 

[Corall]

Try to explain better:

The data range is not the same in the copy sheets.
Let's say that in file 1, sheet1 (each file would have only one sheet) the data range is C3: K14 (this is just an example, the range is much larger), in range C3: K3 is a "Name" header.
This column with the name "Name" will be copied into a newly created sheet, in column A (beginning with A2), and the other columns will be copied in columns B to I. No blank columns will be copied.
ex:

asd	dfsdf	ghfj	rtwert	ytry	Name	sad	fgdfgd	ghfgh
1	2	3	4	5	a	6	7	8
1	2	3	4	5	b	6	7	8
1	2	3	4	5	c	6	7	8
1	2	3	4	5	d	6	7	8
1	2	3	4	5	e	6	7	8
1	2	3	4	5	f	6	7	8
1	2	3	4	5	g	6	7	8
1	2	3	4	5	h	6	7	8
1	2	3	4	5	i	6	7	8
1	2	3	4	5	j	6	7	8
1	2	3	4	5	k	6	7	8

<colgroup><col width="27" style="width: 20pt; mso-width-source: userset; mso-width-alt: 967;"> <col width="37" style="width: 28pt; mso-width-source: userset; mso-width-alt: 1308;"> <col width="29" style="width: 22pt; mso-width-source: userset; mso-width-alt: 1024;"> <col width="44" style="width: 33pt; mso-width-source: userset; mso-width-alt: 1564;"> <col width="30" style="width: 22pt; mso-width-source: userset; mso-width-alt: 1052;"> <col width="43" style="width: 32pt; mso-width-source: userset; mso-width-alt: 1536;"> <col width="27" style="width: 20pt; mso-width-source: userset; mso-width-alt: 967;"> <col width="44" style="width: 33pt; mso-width-source: userset; mso-width-alt: 1564;"> <col width="39" style="width: 29pt; mso-width-source: userset; mso-width-alt: 1393;"> <tbody> </tbody>

and will be copied from A2 to I13, like this:

Name	asd	dfsdf	ghfj	rtwert	ytry	sad	fgdfgd	ghfgh
a	1	2	3	4	5	6	7	8
b	1	2	3	4	5	6	7	8
c	1	2	3	4	5	6	7	8
d	1	2	3	4	5	6	7	8
e	1	2	3	4	5	6	7	8
f	1	2	3	4	5	6	7	8
g	1	2	3	4	5	6	7	8
h	1	2	3	4	5	6	7	8
i	1	2	3	4	5	6	7	8
j	1	2	3	4	5	6	7	8
k	1	2	3	4	5	6	7	8

<colgroup><col width="43" style="width: 32pt; mso-width-source: userset; mso-width-alt: 1536;" span="9"> <tbody> </tbody>

Thank you.

 

[DanteAmor]

That is a nice example, with that, not much explanation is necessary.

Please:
One thing you must keep in mind when you ask a question in a forum... the people you are asking to help you know absolutely nothing about your data, absolutely nothing about what you want done with it and absolutely nothing about how whatever it is you want done is to be presented back to you as a result... you must be very specific about describing each of these areas, in detail, and you should not assume that we will be able to "figure it out" on our own

Try this:

Sub Copy_data()
  Dim wFiles As Variant, wFolder As String
  Dim wb1 As Workbook, wb2 As Workbook, sh2 As Worksheet, sh1 As Worksheet
  Dim lr As Long, lc As Long, f As Range, ic As Long
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set wb1 = ThisWorkbook
  wFolder = "C:\trabajo\books\"
  If Right(wFolder, 1) <> "\" Then wFolder = wFolder & "\"
  If Dir(wFolder, vbDirectory) = "" Then
    MsgBox "Folder does not exist"
    Exit Sub
  End If
  wFiles = Dir(wFolder & "*.xls*")
  Do While wFiles <> ""
    Set wb2 = Workbooks.Open(wFolder & wFiles)
    Set sh2 = wb2.Sheets(1)
    Set f = sh2.Cells.Find("NAME", , xlValues, xlWhole, xlByRows)
    If Not f Is Nothing Then
      lr = sh2.Cells(Rows.Count, f.Column).End(xlUp).Row
      lc = sh2.Cells(f.Row, Columns.Count).End(xlToLeft).Column
      If f.Column = 1 Then
        ic = 1
      Else
        If f.Offset(, -1) <> "" Then
          ic = sh2.Cells(f.Row, f.Column).End(xlToLeft).Column
        Else
          ic = f.Column
        End If
      End If
      wb1.Sheets.Add after:=wb1.Sheets(wb1.Sheets.Count)
      Set sh1 = wb1.ActiveSheet
      sh2.Range(sh2.Cells(f.Row, ic), sh2.Cells(lr, lc)).Copy
      sh1.Range("A2").PasteSpecial xlPasteValues
      Set f = sh1.Cells.Find("NAME", , xlValues, xlWhole, xlByRows)
      sh1.Columns(f.Column).Cut
      sh1.Columns("A:A").Insert Shift:=xlToRight
    End If
    wb2.Close False
    wFiles = Dir()
  Loop
  Application.ScreenUpdating = True
  MsgBox "End"
End Sub

 

[Corall]

Dante,

You are right!
Thank you for your understanding and for your time.
The example presented was for one file only. In that folder can be between 2 and 5 files. Can you please modify the code to copy the data from all the files (each data copied, in newly created sheets).
Thanks a lot.

 

[Corall]

I can't modify what I write before.

Sorry. My mistake.
VBA code is EXCELLENT.
Thank you so much.