Question

早上好，我有一个包含600列和500行的电子表格（行数和列数并不总是相同）。我需要使用接下来的6列复制前三列（将粘贴在新工作簿中）。因此，在新工作簿中复制列abc和defghi。然后在新工作簿中再次复制列abc和接下来的六列jklmno，故事继续进行，直到我们到达没有数据的列。这件事有可能吗？

Answer 1

我现在不在Excel上，所以我无法测试，但你应该能够推断出该做些什么：

Option Explicit

Public Sub ExportData()

Dim varColumn As Long
Dim varColumnEnd As Long
Dim varRowEnd As Long
Dim varRowStart As Long
Dim varSplice As Long
Dim varName As String
Dim varCount As Long
Dim varBook As Workbook
Dim varPath As String

varRowStart = 1
varRowEnd = ThisWorkbook.Sheets("Sheet1").Range("A65000").End(xlUp).Row
varColumnEnd = ThisWorkbook.Sheets("Sheet1").Range("XFD1").End(xlToLeft).Column
varCount = 1
varSplice = 6

For varColumn = 4 To varColumnEnd

    If varColumn < varColumnEnd Then

        Set varBook = Workbooks.Add

        ThisWorkbook.Sheets("Sheet1").Range("A" & varRowStart & ":C" & varRow).Copy
        varBook.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
        Application.CutCopyMode = False
        ThisWorkbook.Sheets("Sheet1").Range("D" & varRowStart & ":I" & varRow).Offset(0, (varCount - 1) * varSplice).Copy
        varBook.Sheets("Sheet1").Range("D1").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
        Application.CutCopyMode = False

        varBook.SaveAs "C:/" & varName & "_" & Format(varCount, "00") & ".xlsx"
        varBook.Close

        Set varBook = Nothing

    End If

Next

End Sub

希望有所帮助

Vba从一个电子表格创建多个工作簿

1 个答案: