Question

我有200种不同的工作簿。我想将转置从1张复制并粘贴到另一张工作表中。是否有VBA代码？

例如：工作簿1现在有一个名为工作表A的工作表。

我想复制，将转置工作表A粘贴到工作簿1中的工作表1中。

是否有适用于工作簿1-200的代码？

Sub Macro2() 
    Dim thiswb As Workbook, datawb As Workbook 
    Dim datafolder As String 
    Dim cell As Range, datawblist As Range 
    Dim i As Integer 

    Set thiswb = ActiveWorkbook 
    i = 2 'Have the 40 file names in sheet2 of this workbook in cells A1:A40 
    Set datawblist = Sheets("sheet2").Range("A1:A40") 
    Sheets("sheet1").Cells(i, 1).Select 
    datafolder = "H:\TestData\" 'change this to your directory they're in 

    For Each cell In datawblist 
        Workbooks.Open Filename:=datafolder & cell & ".xlsx", ReadOnly:=True 
        Set datawb = ActiveWorkbook
        Sheets("sheet1").Select 'change this to the sheet name you need to copy from 
        Range("C3").Select 

        Do Until ActiveCell.Value = "" 
            Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(38, ActiveCell.Column)).Copy 
            thiswb.Activate
            Sheets("Sheet1").Select 'change if not sheet1 
            Selection.PasteSpecial Paste:=xlPasteValues, _ 
                                   Operation:=xlNone, _
                                   SkipBlanks:=False, _
                                   Transpose:=True 
            ActiveCell.Offset(0, 36).Select 
            datawb.Activate 
            ActiveCell.Offset(0, 1).Select 
        Loop 

        datawb.Close savechanges:=False 
        thiswb.Activate
        Sheets("sheet1").Select 
        i = i + 1
        Cells(i, 1).Select 
    Next 
End Sub

VBA在不同的工作簿中复制和粘贴转置

0 个答案: