我正在尝试将列从一个工作簿复制到具有固定标题的母版

时间:2013-01-07 14:37:43

标签: excel excel-vba vba

好吧,我想我已经阅读了所有出现的选项,而且还没有得到那些已经得到答案的答案 - 请原谅我,如果它已被回答,我只是特别。

我希望做的是以下内容:

从具有固定(62)标题的主工作簿能够运行宏/ VBA,这将使我能够打开文件(.csv)从该文件中获取列并将它们放在主表单上的相应标题下

.csv文件肯定会有列标题与主文件匹配,但它可能不在同一序列中。

非常感谢您的帮助。

尼克

这是我迄今为止帮助过的代码......

Sub CopyCSV()

'' Find out how many rows are on the CSV sheet
LRCSV = Sheet1.UsedRange.Rows.Count

'' Find out how many columns are on the Data sheet
LCData = Sheet2.UsedRange.Columns.Count

For x = 2 To LRCSV

'' Find the last row and add one to get the first blank row
LRData = Sheet2.UsedRange.Rows.Count + 1

Sheet2.Activate

'' Finds the columns by the headers

If FirstN = "" Then
    For y = 1 To LCData
        If Cells(1, y).Value = "First Name" Then FirstN = y
        If Cells(1, y).Value = "Surname" Then SurN = y
        If Cells(1, y).Value = "Email" Then Email = y
        If Cells(1, y).Value = "Telephone Number" Then TelN = y
    Next y
End If

Sheet1.Activate

Sheet2.Cells(LRData, FirstN).Value = Sheet1.Cells(x, "A").Value
Sheet2.Cells(LRData, SurN).Value = Sheet1.Cells(x, "B").Value
Sheet2.Cells(LRData, Email).Value = Sheet1.Cells(x, "C").Value
Sheet2.Cells(LRData, TelN).Value = Sheet1.Cells(x, "D").Value

Next x

End Sub

它的栏目部分我正在努力...

1 个答案:

答案 0 :(得分:1)

尼克,我采取了一些不同的方法来解决你所面临的问题。但是,我认为这将是一种更清晰的方法,而且更容易理解。

此代码假设您已打开CSV。此外,我填写了许多占位符用于对象。根据您的需求进行更改。我还评论过一些我认为它可以帮助您更全面地理解代码的内容。

Option Explicit

Sub CopyColumns()

'set the variables needed
Dim wkbMain As Workbook, wkbCopy As Workbook
Dim wksMain As Worksheet, wksCopy As Worksheet

Set wkbMain = Workbooks("Master.xlsm")
Set wkbCopy = Workbooks("email - pws a.csv")

Set wksMain = wkbMain.Sheets("Master")
Set wksCopy = wkbCopy.Sheets(1) 'csv files will only ever have 1 sheet

With wksMain

    'capture the header row in the master sheet
    Dim rngFind As Range, cel As Range
    Set rngFind = Intersect(.UsedRange, .Rows(1)) 'assumes contigous header rows
    'Set rngFind = .Range(.Range("A1"),.Range("A" & .Columns.Count).End(xlToRight) ' could use this as well if your data starts in cell A1

    For Each cel In rngFind 'loop through each header in the row

      Dim rngCopy As Range

      With wksCopy

        Set rngCopy = .Rows(1).Find(cel, after:=.Cells(1, .Columns.Count), lookat:=xlPart, LookIn:=xlValues) 'find the header name in the CSV sheet
        'now copy the entire column (minus the header row)
        Set rngCopy = .Range(rngCopy.Offset(1), .Cells(.Rows.Count, rngCopy.Column).End(xlUp))
        rngCopy.Copy Destination:=wksMain.Cells(2, cel.Column) 'paste it to the matching header in the main sheet

      End With

    Next

End With 'this was missing

End Sub