excel - 如何将标题复制并转置到另一张纸上?
问题描述
我正在尝试将源工作表中的标题复制并转置到目标工作表中以用作映射。
我的代码复制了我想要的行下方的行(第 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
解决方案
试试这个。请注意以开头的评论'*
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
推荐阅读
- exchange-server - 本地 MS Exchange 2016 上的 30 条消息限制
- python - 在python中获取每个月的最后一个星期五
- gulp - 在具有单个 gulp 文件的多个项目中选择一个项目文件
- asp.net - 使用 OnDataBound asp:net gridview 合并单元格后对网格视图进行排序
- azure - 如何使用 powershell 为应用服务/Web 应用启用存储帐户备份?
- c++ - C++中的显式转换函数
- sql-server - 如何在不添加新行的情况下从 sql 追加文本文件
- gitlab - 升级到 14.12 后无法访问 gitlab web UI
- angular - 角。将一个兄弟组件的选择器传递给另一个
- regex - Visual Studio 使用正则表达式在脚本标记之间查找文本