[VBA] Copy+Paste from one workbook to an other

[CluelessNobel]

Hi,

So I'm trying to create a macro that would basically copy+paste data from one workbook to an other.

Specifics:
Workbook 1 has say 5 rows and 5 columns
Workbook 2 has 1 row and 5 columns

The columns from each workbook aren't necessarily named the same, and don't come in the same order.



I need the macro to copy+paste the first row of workbook 1 (although column by column), in the right columns of workbook 2.

Once it's done with the first row, I need it to open a new workbook 2, go to the second row of workbook 1 and repeat the copy+pasting tasks until there are no rows containing data left.


Workbook 1:

File Number	Name	#	$	€
1	CR	15	100	500
2	DC	20	200	1000
3	RIO	25	300	1500
4	CM	30	400	2000
5	PU	35	500	2500

<tbody>
</tbody>

Workbook 2 (target workbook):

Number	Data1	Data 2	Data 3	Data 4

<tbody>
</tbody>

I found this code:

Sub A48()

Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open("P:\CAC\Workbook2.xls")


'Name'
Windows("Workbook1.csv").Activate
    Sheets("Workbook1").Select
    Range("B2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Workbook2.xls").Activate
    Sheets("Workbook2").Select
    Range("C2").Select
    ActiveSheet.Paste


'Number'
Windows("Workbook1.csv").Activate
    Sheets("Workbook1").Select
    Range("A2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Workbook2.xls").Activate
    Sheets("Workbook2").Select
    Range("A2").Select
    ActiveSheet.Paste


End Sub

Obviously there is no loop, and I most likely need variables (but I suck at this).

Thanks for taking the time to read this

 

[WaterGypsy]

The way you have described it is very inefficient. Try something like this rather than copying a row at a time.

' Open your workbooks
Workbooks.Open ("Workbook1")
Workbooks.Open ("Workbook2")

' Find the size of book 1

Workbooks("Workbook1").activate
iML = Range("a1").SpecialCells(xlCellTypeLastCell).Row


'Copy from 1 to 2

Sheets("Sheet1").range("a2:a" &iML).Copy Destination:=Workbooks("Workbook2").Sheets("Sheet1").Range("a2")


Obviously you need to change the columns in the above statement to match the source and destination columns you want and repeat the line for each column.

 

[CluelessNobel]

This is the code we've worked on so far, maybe it's easier to grasp this way. I find it hard to describe what it's about.

Sub A48()

Dim wb As Workbook
Dim nbreligne As Integer




Set wb = Workbooks.Open("P:\COMMISSARIAT AUX COMPTES\2015\A 48\A48_audit_CQ_2016_ex_2015.xls")


Workbooks.Open Filename:="P:\COMMISSARIAT AUX COMPTES\2015\A 48\A48_audit_CQ_2016_ex_2015.xls"




'Counts the number of lines in the source file
Windows("20160913_Aglae_DA_2016.csv").Activate
Sheets("20160913_Aglae_DA_2016").Select
Range("A1").Select
nbligne = Range("A1", Selection.End(xlDown)).Cells.Count


'Variable
Dim ligne As Integer


ligne = 2




Do


'N° MANDAT'
Windows("20160913_Aglae_DA_2016.csv").Activate
Sheets("20160913_Aglae_DA_2016").Select
Range("A" & ligne).Select
Application.CutCopyMode = False
Selection.Copy
Windows("A48_audit_CQ_2016_ex_2015.xls").Activate
Sheets("CONTROLE QUALITE AUDIT 2016").Select
Range("A6").Select
ActiveSheet.Paste
    
'Nom dossier'
Windows("20160913_Aglae_DA_2016.csv").Activate
Sheets("20160913_Aglae_DA_2016").Select
Range("I" & ligne).Select
Application.CutCopyMode = False
Selection.Copy
Windows("A48_audit_CQ_2016_ex_2015.xls").Activate
Sheets("CONTROLE QUALITE AUDIT 2016").Select
Range("B6").Select
ActiveSheet.Paste




ActiveWorkbook.SaveAs Filename:="P:\COMMISSARIAT AUX COMPTES\2015\A 48\Extraction macro" & "\" & [B6].Value & ".xls"
ActiveWorkbook.Close savechanges:=False


Workbooks.Open Filename:="P:\COMMISSARIAT AUX COMPTES\2015\A 48\A48_audit_CQ_2016_ex_2015.xls"




ligne = ligne + 1
    
    
Loop While ligne < nbligne




End Sub