PDA

View Full Version : Copying and Paste files



afzalw
03-08-2013, 09:50 PM
Macro to copy files from one folder to another folder.
All the source paths are in Column A and all destination path are in column B in front of each other (same row).

Source path in column A1 = C:\1.txt
Destination path in Column B1 = C:\a\1.txt

all folders exist no need to create a new folder only copy and paste.

I made this macro but something is wrong its not working.
Thanyou


Sub M20CopyFileandDeletedFolder()
'Create Object

Set fs = CreateObject("Scripting.FileSystemObject")
With ThisWorkbook.Sheets(1)
oldpath = .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).Value
End With

With ThisWorkbook.Sheets(1)
newpath = .Range("B2", .Cells(Rows.Count, 1).End(xlUp)).Value
End With

For i = LBound(oldpath) To UBound(oldpath)
FileCopy oldpath(i, 1), newpath(i, 1)

i = i + 1
Next i
End Sub

patel
03-09-2013, 02:35 AM
Sub copy2()
Set fs = CreateObject("Scripting.FileSystemObject")
With ThisWorkbook.Sheets(1)
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
oldpath = .Range("A2:A" & LR)
newpath = .Range("B2:B" & LR)
End With
For i = LBound(oldpath) To UBound(oldpath)
filecopy oldpath(i, 1), newpath(i, 1)
Next i
End Sub

sassora
03-09-2013, 09:14 AM
Here is a solution to your problem.

The following code creates old and new path arrays and then copies the files over.

Sub M20CopyFileandDeletedFolder()

Dim oldpath() As String
Dim newpath() As String
Dim firstrow As Long
Dim lastrow As Long
Dim cnt As Long

firstrow = 1
lastrow = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

ReDim oldpath(firstrow To lastrow)
ReDim newpath(firstrow To lastrow)

For cnt = firstrow To lastrow

'Old path in column A and New path in column B
oldpath(cnt) = ThisWorkbook.Sheets(1).Cells(cnt, 1)
newpath(cnt) = ThisWorkbook.Sheets(1).Cells(cnt, 2)

Next cnt


For cnt = LBound(oldpath) To UBound(oldpath)

FileCopy oldpath(cnt), newpath(cnt)

Next cnt

End Sub

afzalw
03-09-2013, 04:24 PM
Thankyou Patel and Sassora.

snb
03-10-2013, 01:02 PM
Sub M_snb()
for each cl in columns(1).specialcells(2)
filecopy cl.value,cl.offset(,1).value
next
End Sub

sassora
03-10-2013, 02:00 PM
Straight to the point snb, I like it!