Question

我寻求帮助，将第一张工作表（第D列）中的单元格值复制到16个现有工作表中的指定单元格位置

我想要的价值在sheet1到sheet2（G5）中的D2 in

在Sheet1到sheet3（G5）中的D3 in

在sheet1到sheet4（G5）中的D4

依此类推，直到D16被复制到sheet16的G5

我是一个新手，我看了几个答案并尝试自己解决但......没有发生任何事情

Sub latitude()
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Do Until IsEmpty(ActiveCell)
Sheets("Calculations").Select
Range("d2").Copy
    ActiveCell.Offset(1, 0).Select
'at this point i want it to copy "D3" on next loop
ActiveSheet.Range("G5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Loop
ActiveSheet.Next.Select
' and because the "Sheets("Calculations").Select" above takes it to the first sheet the whole script is a waste till now
Next I
End Sub

Answer 1

试一试。

Option Explicit
Sub Copy_to_G5()
    Dim sht1 As Worksheet, ws As Worksheet
    Dim i As Integer
    Dim shtname As String

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set sht1 = Sheets("Sheet1")
    i = 2
    Do Until i = 17
        shtname = "Sheet" & i
        sht1.Cells(i, 4).Copy
        Sheets(shtname).Range("G5").PasteSpecial
    i = i + 1
    Loop

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Answer 2

Alistairs尝试是好的，但我不会使用shtname = "Sheet" & i，而是尝试以下解决方案并考虑使用它（工作表的存在）;）

Sub Copy_to_G5()
    Dim i As Integer

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    i = 2
    Do Until i = 17
        With ThisWorkbook
        .Worksheets(1).Cells(i, 4).Copy
        .Worksheets(i).Range("G5").PasteSpecial
        End With
    i = i + 1
    Loop

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

每次使用循环将列中的每个单元格复制到新工作表中的特定单元格

2 个答案: