从Sheet3复制一行，粘贴到Sheet1，另存为文件，然后转到Sheet 3的下一行

Question

I am trying to find a way to streamline a very repetitive task.

This is the first time I am trying to build a proper macro, so things are confusing for me.

Below is an attempt to make it work.

Sub test()
Dim r As Range, j As Integer
Set r = Range("A2:C500")
Do
 Sheets("Sheet1").Range(r.Offset(1, 0)).Select
 Selection.Copy
 Sheets("Sheet1").Select
Range("D2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("D2:F494")
Range("D2:F494").Select
ActiveWorkbook.SaveAs Filename = j, FileFormat:=xlUnicodeText, _
    CreateBackup:=False

If r.Offset(1, 0) = "" Then Exit Do
Loop
End Sub

I am trying to
- copy Row A2:C2 from Sheet 3
- paste it into D2 of Sheet 1
- drag that value all the way down to the end of Sheet 1
- Save Sheet 1 as text file (any file name is fine. I was trying to save as 1, 2, 3, and so on.)
- Then go to the next row of Sheet 3 (A3:C3) and repeat the process until it reaches the last row, A500:C500.

When I recorded the macro for just the first row, it looked as follows:

  Sheets("Sheet3").Select
Range("A2:C2").Select
Selection.Copy
Sheets("Sheet1").Select
Range("D2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("D2:F494")
Range("D2:F494").Select
ActiveWorkbook.SaveAs Filename:= _
    "D:\Users\XXX\Desktop\XXX. XX\1.txt", FileFormat:=xlUnicodeText, _
    CreateBackup:=False

ANY help would be greatly appreciated!

Answer 1

It's not clear what you want to do. Sounds like you are saying you want to copy a row (or some cells in a row) from one sheet to a particular single cell on another sheet and then export that sheet to a text file. This seems strange. Why not just write a macro to get all the data you want and directly write it to file in the first place? Do you just want all the data from all rows of the first three columns of "sheet3" exported to a file? Or is there boilerplate stuff in the other parts of "sheet1" that you want to be in every on of these text files?

Or do you want to create 500 text files, each with a row from sheet3?

Answer 2

You are saving the ActiveWorkbook so it won't save the sheets as individual files. You need to create a new workbook for each set of data using Workbooks.Add , then save and close each of these new workbooks once you've copied the data.

(A Worksheet has a SaveAs method, but it doesn't work - it doesn't save an individual sheet from a workbook.)

You can fill the entire area using Paste or PasteSpecial without having to fill it down:

Worksheets("Sheet3").Range("A2:C2").Copy
Worksheets("Sheet1").Range("D2:F494").PasteSpecial xlValues
Application.CutCopyMode = False

I'm afraid the recorder will only get you so far, and you'll need to study and modify the code that it creates.