Copy columns to new workbook and save as csv

0
votes

I'm trying to:

  • Copy data (columns A and B) from one workbook (data.xlsx).
  • Paste into a new workbook (as values).
  • Save as CSV with a filename taken from column A in a third workbook (URLs.xlsx).
  • Process to repeat, taking the same data (which is randomised every time it is pasted) from data.xlsx and pasted into a new CSV - there are 200 rows in URLs.xlsx and so we should end up with 200 files.

I've read lots of topics, here are two I found:

Excel VBA Copy a Range into a New Workbook
https://www.excelcampus.com/vba/copy-paste-another-workbook/

What I've tried

Copying code and replacing the relevant components from various different articles across the web. Some of them work, but when I add the missing bits, I run into errors I don't understand.

2
excelvba
how is the data randomised every time it is pasted? – AAA
The data.xlsx file has some =RANDBETWEEN function in it to randomise numbers for columns A and B. Thanks – Tjm92
Thanks again for your response. When I've tried doing this manually, each time I paste into the new workbook it automatically refreshes the random number generation in the data.xlsx file. Will this not continue to occur? – Tjm92

2 Answers

0
votes

Well here is an example avoiding copy pasting in new workbooks:

Expected input like:

Data.xlsx range A1:B200 with RANDBETWEEN() function:

enter image description here

URLs.xlsx range A1:A200 with some URL like so:

enter image description here

Run this code (will take approximately 1 second on my machine, tested with timer):

Dim wbData As Workbook, WBurls As Workbook
Dim CSVFileDir As String, CSVVal As String
Dim A As Long, X As Long, Y As Long, Z As Long

Option Explicit

Sub Transfer2CSV()

Set wbData = Workbooks("data.xlsx") 'Make sure it is open upon running macro
Set WBurls = Workbooks("URLs.xlsx") 'Make sure it is open upon running macro

For X = 1 To 200 'Looping through the 200 rows of WBurls
    CSVFileDir = "C:\YourDrive\" & WBurls.Sheets(1).Cells(X, 1).Value & ".csv"
    CSVVal = ""
    A = FreeFile
    Open CSVFileDir For Output As #A
    With wbData.Sheets(1).Range("A1:B200") ' or whichever range you using here
        .Calculate 'Randomize your range again
        For Y = 1 To 200 'or however many rows you have in column A and B.
            For Z = 1 To 2
                CSVVal = CSVVal & .Cells(Y, Z).Value & ","
            Next Z
            Print #A, Left(CSVVal, Len(CSVVal) - 2)
            CSVVal = ""
        Next Y
    End With
    Close #A
Next X

End Sub

Output:

enter image description here

With each file looking like:

enter image description here

0
votes

This should work. Make sure your data and URLS workbooks are open.

Sub Macro1()

Dim wsData As Worksheet, wsUrl As Worksheet, wbNew as Workbook
Dim CSVDir as String, rngU As Range

Set wsData = Workbooks("data.xlsx").Worksheets(1)
Set wsUrl = Workbooks("URLs.xlsx").Worksheets(1)
Set rngU = wsUrl.Range("A1", wsUrl.Range("A" & wsUrl.Rows.Count).End(xlUp))
CSVDir = "C:\Users\thomas.mcerlean\Desktop\Work\" 'you gave this as your dir
Set wbNew = Workbooks.Add

For Each cell In rngU
    wsData.Range("A1", wsData.Range("B" & wsData.Rows.Count).End(xlUp)).Copy Destination:= wbNew.Worksheets(1).Range("A1")
    wbNew.SaveAs Filename:= CSVDir & cell.Value & ".csv", FileFormat:=xlCSV
Next cell

wbNew.Close SaveChanges:=False
End Sub