使用VBA将数据从一个工作表复制到基于单元格值的新工作表



我刚开始使用VBA,我正试着玩一下,看看我能做些什么。

我正在尝试编写一个宏,从主工作表上的数据子部分自动生成报告。

我想只复制列D中的值为"China"且H列中的值为"HS">. 此外,我只希望从选择的行(a:C,E,F,G,I,Q,R,AF:AH,AN,AP,AQ)复制数据。

到目前为止,我是这样做的:
  1. 新建工作表
  2. 复制标题行
  3. 查找相关数据并复制/粘贴到新表格

根据我在这里和其他论坛找到的一些答案,我整理了以下内容。上半部分工作得很好(生成表格和复制标题行),但主要的重要部分没有。

如果这是一个科学怪人的工作请原谅我,我是新来的,但正在努力学习!

Option Explicit
Sub GenerateHSReport()
'Generating the sheet'
Sheets.Add(Count:=1).Name = "HS Report " & Format(Date, "DD-MM-YY")
'Adding the title row'
Sheets("SANBI - all bids").Range("A4:C4,E4,F4,G4,I4,Q4,R4,AF4:AH4,AN4,AP4,AQ4").Copy
Sheets("HS Report " & Format(Date, "DD-MM-YY")).Activate
Range("A1").Select
ActiveSheet.Paste
'Copying the HS data'
Dim srchtrm As String
Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim c As Range
Dim i As Integer
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set shtSrc = Sheets("SANBI - all bids")
Set shtDest = Sheets("HS Report " & Format(Date, "DD-MM-YY"))
Set c = Range("A5:C5,E5,F5,G5,I5,Q5,R5,AF5:AH5,AN5,AP5,AQ5")
destRow = 2
Set rng = Application.Intersect(shtSrc.Range("D:D, H:H"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value = "HS" And c.Value = "China" Then

c.Copy shtDest.Cells(destRow, 2)

destRow = destRow + 1

End If
Next
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With

Application.CutCopyMode = False
End Sub

谢谢评论,它有效!多么令人兴奋啊!仅供参考,我必须为我想复制的每一列添加一行,如下所示。也许它有点乱,但它似乎工作!


shtDest.Cells(destRow, 1).Value = Row.Columns("a").Value
shtDest.Cells(destRow, 2).Value = Row.Columns("b").Value
shtDest.Cells(destRow, 3).Value = Row.Columns("c").Value
'...etc'

我在用手机,所以我现在不能测试,但它应该会指引你正确的方向

Set rng = shtSrc.UsedRange
Dim row as range
For Each row In rng.rows
If row.columns("h").value = "HS" And row.columns("d").value = "China" Then

shtDest.Cells(destRow, 2).value = Row.columns("b").value
destRow = destRow + 1

End If
Next

类似的东西,你明白了,它没有被测试

相关内容

最新更新