Наименование каждого столбца диапазона переменных на основе данных в одном столбце

Question

Я пытаюсь присвоить каждому заголовку столбца один и тот же базовый заголовок, но, изменяя значение единицы, все данные для этой единицы находятся в столбце D. Мои навыки VBA очень просты c. Когда я запускаю код, появляются заголовки, а фактические значения - нет, и между каждым заголовком есть пробел в один столбец. Я не уверен, почему это происходит

Private Sub Viscosity_Temperature()

    Dim dsvt As Worksheet
    Dim dst As Worksheet
    Dim sr As Range
    Dim t As Range
    Dim rng As Range
    Dim rn As Integer
    Dim rn2 As Integer
    Dim cl As String
    Dim i As Integer

    Set dst = Worksheets("Template 2 - Down Sweep")
    Sheets.Add.Name = "DownSweep ViscosityTemperature"
    Set dsvt = Worksheets("DownSweep ViscosityTemperature")

    dst.Range(dst.Range("H1"), dst.Range("H1").End(xlDown)).Copy
    dsvt.Range("D1").PasteSpecial Paste:=xlPasteValues
    dst.Range(dst.Range("D1"), dst.Range("D1").End(xlDown)).Copy
    dsvt.Range("A1").PasteSpecial Paste:=xlPasteValues
    dst.Range(dst.Range("C1"), dst.Range("C1").End(xlDown)).Copy
    dsvt.Range("B1").PasteSpecial Paste:=xlPasteValues
    dst.Range(dst.Range("F1"), dst.Range("F1").End(xlDown)).Copy
    dsvt.Range("C1").PasteSpecial Paste:=xlPasteValues

    Set rng = dsvt.Range(dsvt.Range("D1"), dsvt.Range("D1").End(xlDown))
    rn = rng.Rows.Count
    rn2 = rn + 6
    cl = Split(Cells(1, rn2).Address, "$")(1)

    Set sr = dsvt.Range(dsvt.Range("D2"), dsvt.Range("D2").End(xlDown))
    Set t = dsvt.Range("F1:" & cl & "1")
    i = 1

For i = 1 To rn
t(1, i).Value = "Viscosity at" & sr(i, 4) & "1/s"
i = i + 1
Next i

End Sub

Любая помощь будет оценена.

Answer 1

Я обнаружил ошибку - поиск значений в одном столбце и добавление 1 к I, когда он будет следующий.

Private Sub Viscosity_Temperature()

    Dim dsvt As Worksheet
    Dim dst As Worksheet
    Dim sr As Range
    Dim t As Range
    Dim rng As Range
    Dim rn As Integer
    Dim rn2 As Integer
    Dim cl As String
    Dim i As Integer

    Set dst = Worksheets("Template 2 - Down Sweep")
    Sheets.Add.Name = "DownSweep ViscosityTemperature"
    Set dsvt = Worksheets("DownSweep ViscosityTemperature")

    dst.Range(dst.Range("H1"), dst.Range("H1").End(xlDown)).Copy
    dsvt.Range("D1").PasteSpecial Paste:=xlPasteValues
    dst.Range(dst.Range("D1"), dst.Range("D1").End(xlDown)).Copy
    dsvt.Range("A1").PasteSpecial Paste:=xlPasteValues
    dst.Range(dst.Range("C1"), dst.Range("C1").End(xlDown)).Copy
    dsvt.Range("B1").PasteSpecial Paste:=xlPasteValues
    dst.Range(dst.Range("F1"), dst.Range("F1").End(xlDown)).Copy
    dsvt.Range("C1").PasteSpecial Paste:=xlPasteValues

    Set rng = dsvt.Range(dsvt.Range("D1"), dsvt.Range("D1").End(xlDown))
    rn = rng.Rows.Count
    rn2 = rn + 6
    cl = Split(Cells(1, rn2).Address, "$")(1)

    Set sr = dsvt.Range(dsvt.Range("D2"), dsvt.Range("D2").End(xlDown))
    Set t = dsvt.Range("F1:" & cl & "1")
    i = 1

For i = 1 To rn - 1
t(1, i).Value = "Viscosity at " & sr(i, 1) & " 1/s"
Next i

End Sub

 1. List item