首页 > 解决方案 > 如何将标题复制并转置到另一张纸上?

问题描述

我正在尝试将源工作表中的标题复制并转置到目标工作表中以用作映射。

我的代码复制了我想要的行下方的行(第 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

标签: excelvbacopy-paste

解决方案


试试这个。请注意以开头的评论'*

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

推荐阅读