Question

当目标工作表名称是源工作表名称时，我想从源工作簿将信息传输到目标工作簿。

我是VBA的新手，现在已经使用了2个星期，并且直接用Google搜索了我的a $$。到目前为止，该网站已被证明是最好的hulp。

我必须将标准基础上的大量信息转换为不同的格式，我希望通过以下代码自动执行此操作：

Sub Transfer()
Dim wbt As Workbook, wbs As Workbook 'wbt = workbook target, wbs = workbooksource
Dim wst As Worksheet, wss As Worksheet 'wbt = worksheet target, wbs = worksheet source
Dim wkt As Integer, wks As Integer, wke As Integer 'wkt = number in target sheet name, wks = number in source sheet name, wke = number in sheet name after which I want to stop transferring information

Dim vFile As Variant

Dim CCT As Range, CCS As Range

Set wbt = ActiveWorkbook

vFile = Application.GetOpenFilename("Excel-files,*.xlsm", _
    1, "Select One File To Open", , False)


If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile

Set wbs = ActiveWorkbook

 wkt = 1
 wks = 1
 wke = 16

For Each wks In wbt.wst.("WK " & wkt)

       If wks = wkt Then

    wbt.wst("WK " & wkt).Range("K13:K63").Value = wbs.wss("WK " & wks).Range("G8:G58").Value
    wbt.wst("WK " & wkt).Range("m13:m63").Value = wbs.wss("WK " & wks).Range("h8:h58").Value

    wkt = wkt + 1
    wks = wks + 1

    If wke > wkt Then

        wbs.Close (False)
Next

End Sub

Answer 1

这已经更好了：

Sub Transfer()
Dim wbt As Workbook, wbs As Workbook 'wbt = workbook target, wbs = workbooksource
Dim wst As Worksheet, wss As Worksheet 'wbt = worksheet target, wbs = worksheet source
Dim wkt As Integer, wks As Integer, wke As Integer 'wkt = number in target sheet name, wks = number in source sheet name, wke = number in sheet name after which I want to stop transferring information

Dim vFile As Variant

Dim CCT As Range, CCS As Range

Set wbt = ActiveWorkbook

vFile = Application.GetOpenFilename("Excel-files,*.xlsm", _
    1, "Select One File To Open", , False)


If TypeName(vFile) = "Boolean" Then Exit Sub


Set wbs = Workbooks.Open(vFile)

' wkt = 1
' wks = 1
 wke = 16

For Each wss In wbs.Sheets
    For Each wst In wbt.Sheets

        If wst.Name <> wss.Name Or CInt(Replace(wss.Name, "WK ", "")) >= wke Then
        Else
            wst.Range("K13:K63").Value = wss.Range("G8:G58").Value
            'wbt.wst("WK " & wkt).Range("m13:m63").Value = wbs.wss("WK " & wks).Range("h8:h58").Value

'            wkt = wkt + 1
'            wks = wks + 1
        End If
'        If wke > wkt Then wbs.Close (False)
    Next wst
Next wss

wbs.Close
Set wbs = Nothing
Set wbt = Nothing
End Sub

我真的没有得到你的“wke”，这是你要限制你的副本的工作表名称中的数字？如果是，代码可能已经足够改变了。

顺便说一下，Set是一种创建更快的引用以便以后在代码中使用的方法，但你不能在那里添加参数，你必须在代码的末尾释放它们，{{1 }}

Answer 2

感谢转发。我实际上找到了一种方法来使代码符文流利。完成的代码是：选项明确 Sub Data_Transfer_Ur1_1_1_to_UR1_2（）

Dim wbt As Workbook, wbs As Workbook
Dim wst As Worksheet, wss As Worksheet

Dim vFile As Variant

Dim CCT As Range, CCS As Range
Dim array1(1 To 53) As String
Dim og As Integer, bg As Integer

'Set source workbook
Set wbt = ActiveWorkbook

'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsm", _
    1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub

If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set targetworkbook

Dim j As Integer

DataTransferUserForm.Show

og = DataTransferUserForm.InputBoxOG.Value
bg = DataTransferUserForm.InputBoxBG.Value

For j = og To bg
    array1(j) = "WK " + CStr(j)
Next j
Set wbs = ActiveWorkbook

Dim i As Integer


For i = 1 To UBound(array1)


        wbt.Worksheets(array1(i)).Range("K13:K63").Value = wbs.Worksheets(array1(i)).Range("G8:G58").Value
        wbt.Worksheets(array1(i)).Range("m13:m63").Value = wbs.Worksheets(array1(i)).Range("h8:h58").Value

        Set CCT = wbt.Worksheets(array1(i)).Range("O13")

    For Each CCS In wbs.Worksheets(array1(i)).Range("J8:J58")

        If CCS.Value > 0 Then
            CCT.Value = "z"
            CCT.Offset(0, 1).Value = CCS.Value
        End If
        Set CCT = CCT.Offset(1, 0)
    Next

    Set CCT = wbt.Worksheets(array1(i)).Range("O13")
    For Each CCS In wbs.Worksheets(array1(i)).Range("K8:K58")
        If CCS.Value > 0 Then
           CCT.Value = "i"
           CCT.Offset(0, 1).Value = CCS.Value
        End If
        Set CCT = CCT.Offset(1, 0)
    Next

    Set CCT = wbt.Worksheets(array1(i)).Range("O13")
    For Each CCS In wbs.Worksheets(array1(i)).Range("L8:L58")
        If CCS.Value > 0 Then
            CCT.Value = "v"
            CCT.Offset(0, 1).Value = CCS.Value
        End If
        Set CCT = CCT.Offset(1, 0)
    Next

    Set CCT = wbt.Worksheets(array1(i)).Range("O13")
    For Each CCS In wbs.Worksheets(array1(i)).Range("m8:m58")
        If CCS.Value > 0 Then
            CCT.Value = "o"
            CCT.Offset(0, 1).Value = CCS.Value
        End If
        Set CCT = CCT.Offset(1, 0)
    Next

    Set CCT = wbt.Worksheets(array1(i)).Range("O13")
    For Each CCS In wbs.Worksheets(array1(i)).Range("n8:n58")
        If CCS.Value > 0 Then
        CCT.Value = "bv"
        CCT.Offset(0, 1).Value = CCS.Value
        End If
           Set CCT = CCT.Offset(1, 0)
    Next

        wbt.Worksheets(array1(i)).Range("q13:q63").Value = wbs.Worksheets(array1(i)).Range("O8:O58").Value
        wbt.Worksheets(array1(i)).Range("r13:r63").Value = wbs.Worksheets(array1(i)).Range("P8:P58").Value

Next i

wbs.Close (False)
wbt.Show

VBA将工作簿1中工作表中的信息传输到另一个工作簿中具有相同工作表名称的工作表

2 个答案: