如何将 headers 复制并转置为另一个 sheet？

Question

我正在尝试将我的源作品sheet中的headers复制并转置到我的目标sheet中以用作映射。

我的代码复制了我想要的行（第 1 行）下方的行。

Sub Create_Mappings()
Dim source_sht As Worksheet
Dim target_sht As Worksheet

Dim src_raw_rng As Range 'Ranges for headings from raw_data
Dim trg_raw_rng As Range

Dim src_map_rng As Range 'Ranges for mapping headings
Dim trg_map_rng As Range

Dim last_row As Long
Dim last_column As Long

Set source_sht = ThisWorkbook.Worksheets(6)
Set target_sht = ThisWorkbook.Worksheets(4)

'Determine last row of data in Mappings sheet and last column in first row of Raw_Data
last_row = target_sht.Cells(target_sht.Rows.Count, "C").End(xlUp).Row
last_column = source_sht.Cells(source_sht.Range("A1"), source_sht.Columns.Count).End(xlToLeft).Column

'Clear mappings

Set src_raw_rng = source_sht.Range(source_sht.Cells(1, 1), source_sht.Cells(1, last_column))

Set trg_raw_rng = target_sht.Range(Range("InpVarStart"), target_sht.Cells(last_row + 1, 3))
   
trg_raw_rng.Clear

src_raw_rng.Copy
trg_raw_rng.PasteSpecial Transpose:=True

End Sub

Answer 1

试试这个。请注意以'*

开头的评论

Sub Create_Mappings()
  Dim source_sht As Worksheet
  Dim target_sht As Worksheet
  
  Dim src_raw_rng As Range 'Ranges for headings from raw_data
  Dim trg_raw_rng As Range
  
  Dim src_map_rng As Range 'Ranges for mapping headings
  Dim trg_map_rng As Range
  
  Dim last_row As Long
  Dim last_column As Long
  
  Set source_sht = Sheet6 ' ThisWorkbook.Worksheets(6)
  Set target_sht = Sheet4 ' ThisWorkbook.Worksheets(4)
  
  'Determine last row of data in Mappings sheet and last column in first row of Raw_Data
  last_row = target_sht.Cells(target_sht.Rows.Count, "C").End(xlUp).Row
  
  '* changed source_sht.Range("A1") to 1
  '* you can use source_sht.Range("A1").Row, but 1 is better since you are hard-coding "A1"
  last_column = source_sht.Cells(1, source_sht.Columns.Count).End(xlToLeft).Column
  
  'Clear mappings
  
  Set src_raw_rng = source_sht.Range(source_sht.Cells(1, 1), source_sht.Cells(1, last_column))
  
  Set trg_raw_rng = target_sht.Range(Range("InpVarStart"), target_sht.Cells(last_row + 1, 3))
     
  trg_raw_rng.Clear
  
  src_raw_rng.Copy
  '* Use first cell of target range
  trg_raw_rng.Cells(1, 1).PasteSpecial Transpose:=True
  trg_raw_rng.Select
End Sub

如何将 headers 复制并转置为另一个 sheet？

How to copy and transpose headers to another sheet?

excel

vba

copy-paste