Скопируйте столбцы в новую книгу и сохраните как csv

Question

Я пытаюсь:

• Копирование данных (столбцы A и B) из одной рабочей книги (data.xlsx).
• Вставить в новую рабочую книгу (как значения).
• Сохранить как CSV с именем файла, взятым из столбца А в третьей книге (URLs.xlsx).
• Процесс повторения, при котором одни и те же данные (которые рандомизируются каждый раз, когда они вставляются) из data.xlsx и вставляются в новый CSV - в URLs.xlsx есть 200 строк, поэтому мы должны получить 200 файлов.

Я прочитал много тем, вот две, которые я нашел:

Excel VBA Копирование диапазона в новую рабочую книгу
https://www.excelcampus.com/vba/copy-paste-another-workbook/

Что я пробовал

Копирование кода и замена соответствующих компонентов из различных статей в Интернете. Некоторые из них работают, но когда я добавляю пропущенные биты, я сталкиваюсь с ошибками, которые не понимаю.

Answer 1

Это должно работать.Убедитесь, что ваши данные и рабочие книги URL-адресов открыты.

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

Answer 2

Вот пример, позволяющий избежать вставки копий в новых книгах:

Ожидаемый ввод, например:

Диапазон Data.xlsx A1:B200 с функцией RANDBETWEEN():

диапазон URLs.xlsx A1:A200 с некоторыми URL-адресами, например:

Выполнитьэтот код (займет примерно 1 секунду на моей машине, проверено таймером):

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

Выход:

Скаждый файл выглядит так: